1、首先在开发工具中打开VBA编辑器
2、在单元格区域当中输入一些内容作为例子
3、在VBA编辑器中插入模块
4、在模块当中输入如下代码，然后运行Sub多工作簿合并到当前工作表()Dim ppath As String, dir荏鱿胫协name, active_book As String, sheet_count As Long, i As Integer, ans As Byte ans=Application.InputBox("请确认在工作簿的标题行数：", "标题行", 1, , , , , 1) '默认为1Application.ScreenUpdating=False'为三个变量赋值ppath=ActiveWorkbook.Pathactive_book=ActiveWorkbook.Namedirname=Dir(ppath & "\*.xlsx")'复制标题If dirname <> active_book Then Workbooks.Open Filename:=ppath & "\" & dirname '打开待汇总的目标工作簿 Workbooks(active_book).Activate '激活汇总表 Workbooks(dirname).Sheets(1).Rows("1:" & ans).Copy Rows("1:" & ans) Workbooks(dirname).Close FalseEnd If'复制所有工作簿数据Do While dirname <> "" If dirname <> active_book Then Workbooks.Open Filename:=ppath & "\" & dirname '打开待汇总的目标工作簿 sheet_count=Sheets.Count '为变量赋值为工作簿中工作表数目 Workbooks(active_book).Activate '激活汇总表 For i=1 To sheet_count '复制新打开的工作簿的第一个工作表的已用区域到rng Workbooks(dirname).Sheets(i).UsedRange.Offset(ans, 0).Copy Range("a1048576").End(xlUp).Offset(1, 0) Next Workbooks(dirname).Close False End If dirname=DirLoopApplication.ScreenUpdating=TrueEnd Sub
5、用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序弹出提示框，提示输入各工作表标题行数
