新建一个工作薄,将所有EXCEL表的文件名填到A列中,复制下面VBA代码到工作薄中,保存为excel.xls后执行
Sub xlscopy()
Application.ScreenUpdating = False
'Arr数组由所有EXCEL文件名组成
arr = [A1:A10]
For i = 1 To UBound(arr)
Workbooks.Open "文件夹路径\" & arr(i, 1)
Workbooks(arr(i)(1)).Activate
For j = 1 To ActiveWorkbook.Sheets.Count
Sheets(j).Copy After:=Workbooks("excel.xls").Sheets(Workbooks("excel.xls").Sheets.Count)
Next
Workbooks(arr(i, 1)).Close False
Next
End Sub
汇总2007版及以上excel
Sub 汇总数据()
Dim r&, c&, Filename$, wb As Workbook, sht As Worksheet, erow&, fn$, arr As Variant
r = Sheets(1).Range("A65536").End(xlUp).Row
Application.ScreenUpdating = False
Filename = Dir(ThisWorkbook.Path & "\*.xlsx")
Do While Filename <> ""
If Filename <> ThisWorkbook.Name Then
fn = ThisWorkbook.Path & "\" & Filename
Set wb = GetObject(fn)
Set sht = wb.Worksheets(1)
ThisWorkbook.Sheets(1).Cells(r, 1) = sht.Cells(1, 1).Value
wb.Close False
r = r + 1
End If
Filename = Dir '取得其他工作簿名称
Loop
Application.ScreenUpdating = True
End Sub
用这个合并软件,快速高效