1、首先在开发工具中打开VBA编辑器
2、在单元格区域当中输入一些内容作为例子
3、在VBA编辑器中插入模块
4、在模块当中输入如下代码，然后运行Sub工作簿汇总() 'sql法 Dim paths As String, filess 帆歌达缒As String, shn As String, c As String, biaoti As Byte Dim i%, j%, thiswk, cnn, activewk, rr As Long, cz, r, sh As Worksheet, temp paths=ThisWorkbook.Path & "\" '取得路径 filess=Dir(paths & "*.xlsx") '取得文件名 On Error Resume Next '错误时执行下一步 biaoti=Application.InputBox("请确认在工作簿的标题行数：", "标题行", 1, , , , , 1) '默认为1 Application.ScreenUpdating=False '关闭屏幕刷新 Set thiswk=ThisWorkbook Do While filess <> "" If filess <> ThisWorkbook.Name Then '如果不是当前工作簿 Workbooks.Open paths & filess '则开启该工作簿 Set activewk=ActiveWorkbook '取得当前工作簿名称 For i=1 To activewk.Sheets.Count '为变量赋值，范围为1到工作表数目 cz=0: shn=activewk.Sheets(i).Name '为变量赋值为工作表名 For j=1 To thiswk.Sheets.Count If thiswk.Sheets(j).Name=shn Then cz=1: Exit For Next j If cz=0 Then sheetss activewk.Sheets(i), biaoti r=activewk.Sheets(i).[a1048576].End(xlUp).Row If r > biaoti Then c=Mid(activewk.Sheets(i).Cells(biaoti, 16384).End(xlToLeft) .Address, 2, 2) If Right(c, 1)="$" Then c=Left(c, 1) rr=thiswk.Sheets(shn).[a1048576].End(xlUp).Row+1 Set cnn=CreateObject("Adodb.Connection") Sql="Select * From [" & shn & "$A" & biaoti+1 & ":" & c & r & "]" cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;Hdr=no';Data Source=" & paths & filess thiswk.Sheets(shn).Cells(rr, 1).CopyFromRecordset cnn.Execute(Sql) cnn.Close Set cnn=Nothing End If ActiveSheet.UsedRange.Borders.LineStyle=xlContinuous '加边框Next i Workbooks(filess).Close False '关闭工作簿且不保存 End If filess=DirLoop '为工作表添加边框 For Each sh In thiswk.Worksheets If sh.Name <> "汇总" Then sh.UsedRange.Borders.LineStyle=xlContinuous temp=temp & sh.Name & Chr(10) End If Next shSheets(1).SelectApplication.ScreenUpdating=True MsgBox "本文件夹的工作簿已汇总到本工作簿！" & Chr(10) & "汇总后的工作表名分别为：" _ & Chr(10) & temp, vbOKOnly+64, "汇总完成"End SubSub sheetss(sh As Worksheet, biaoti As Byte)ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)ThisWorkbook.ActiveSheet.Name=sh.Namesh.Rows("1:" & biaoti).Copy ThisWorkbook.ActiveSheet.Cells(1, 1)End Sub
5、用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序弹出提示框，提示输入各工作表标题行数
