在Excel表格中数据的复制汇总是我们经常会遇到的问题,当工作表很多时一个个的复制粘贴会非常麻烦、效率非常低。今天为朋友们分享一段非常简短并且实用的VBA代码来实现复制多个工作簿的数据到一张工作表的操作。
操作步骤:
1.新建一个Excel工作簿将其另存为启用宏的工作簿。
2.鼠标右键点击刚才新建的工作簿的任意一个工作表,点击查看代码,进入VBA代码编辑界面。
3.点击VBA编辑界面上方的插入,选择插入一个模块。
4.复制以下代码到刚才插入的模块:
Sub 复制()
Application.ScreenUpdating = False
Dim ERow As Long, wt As Worksheet, mz As String, sht As Worksheet, wb As Workbook, arr As Variant,allfilename As Variant, openfile As Variant
allfilename = Application.GetOpenFilename(FileFilter:="所有文件,*.*,Excel文件,*.xls; *.xlsx *.xlsm", Title:="选择要复制的工作簿", MultiSelect:=True) '选择文件
Set wt = ThisWorkbook.Worksheets(1)
For Each openfile In allfilename
If openfile <>False Then
Set wb = Workbooks.Open(openfile)
For Each sht In wb.Worksheets
Erow = wt.Range("A1048576").End(xlUp).Row 1
If sht.Visible = True Then
arr = sht.Range("A1:GZ" & (sht.Range("A50000").End(xlUp).Row))
wt.Cells(Erow, "A").Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End If
Next
wb.Close False
End If
Next
Application.ScreenUpdating = True
End Sub
5.保存并关关闭VBA代码编辑界面。
6.按住键盘上的Alt F8键(运行宏的快捷键),点击复制;选择要复制数据的工作簿,点击打开等待几秒钟就可以了。