从多个excel表格中合并到一个汇总excel表格中,相应的sheet序号对
发布时间:2020-12-17 07:59:05 所属栏目:百科 来源:网络整理
导读:今天PHP站长网 52php.cn把收集自互联网的代码分享给大家,仅供参考。 Sub hebin()Dim MyPath As StringDim MyName As StringDim AWbName As String '路径,名称,活动工作簿名称Dim wb As Workbook,WbN As String '工作簿,
以下代码由PHP站长网 52php.cn收集自互联网 现在PHP站长网小编把它分享给大家,仅供参考 Sub hebin() Dim MyPath As String Dim MyName As String Dim AWbName As String '路径,名称,活动工作簿名称 Dim wb As Workbook,WbN As String '工作簿,工作簿名称和数量 Dim ss As Worksheet '当前sheet Dim ws As Worksheet '待处理sheet Dim Num As Long '待处理工作簿数量 Dim ext As String '扩展名 Dim extn As Long '护展名长度 Dim sn As Long 'sheet循环变量 ext = "*.xlsx"'此处是excel2007以上版本所用扩展名,如果是excel2003则应改为ext="*.xls",extn=4 extn = 5 Application.ScreenUpdating = False MyPath = ActiveWorkbook.Path '当前workbook路径 MyName = Dir(MyPath & "" & ext) '当前路径下扩展名为ext的文件 AWbName = ActiveWorkbook.Name '当前workbook名称 Num = 0 Do While MyName <> "" If MyName <> AWbName Then Set wb = Workbooks.Open(MyPath & "" & MyName) '打开扩展名为ext的文件 For sn = 1 To Workbooks(1).Sheets.Count 'Workbooks(1).Activate 'Workbooks(1).Sheets(sn).Select Set ss = Workbooks(1).Sheets(sn) Set ws = wb.Sheets(sn) Call cpsheet(ss,ws,MyName,extn) Next sn Num = Num + 1 '文件计数 WbN = WbN & Chr(13) & wb.Name wb.Close False End If MyName = Dir Loop Range("A1").Select Application.ScreenUpdating = True MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下:" & Chr(13) & WbN,vbInformation,"提示" End Sub Sub cpsheet(ByRef sesheet As Worksheet,wosheet As Worksheet,strs As String,en As Long) '复制sheet Dim ss1 As Worksheet '当前sheet Dim ws1 As Worksheet '待处理sheet Dim i As Long '行循环变量 Dim j As Long '列循环变量 Dim ssr As Long '当前sheet最下面行 Dim wsr As Long '待处理sheet最下面行 Dim wsc As Long '待处理sheet最右边列 Set ss1 = sesheet Set ws1 = wosheet 'ss1.Select '使ss1成为当前sheet With ss1.UsedRange ssr = .Rows.Count + .Row - 1 '当前sheet最大行数 End With With ws1.UsedRange wsr = .Rows.Count + .Row - 1 '待处理sheet最大行数 wsc = .Columns.Count + .Column - 1 '待处理sheet最大列数 End With ss1.Cells(ssr + 1,1) = Left(strs,Len(strs) - en) '隔行显示待处理workbook名称 For i = 1 To wsr For j = 1 To wsc ss1.Cells(ssr + 1 + i,j) = ws1.Cells(i,j) '逐个单元格复制 Next j Next i End Sub 以上内容由PHP站长网【52php.cn】收集整理供大家参考研究 如果以上内容对您有帮助,欢迎收藏、点赞、推荐、分享。 (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |