怎样使用VBA多工作簿数据合并到本工作簿？

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=Dir
Loop
  '为工作表添加边框
  For Each sh In thiswk.Worksheets
  If sh.Name <> "汇总" Then
  sh.UsedRange.Borders.LineStyle=xlContinuous
  temp=temp & sh.Name & Chr(10)
  End If
  Next sh
Sheets(1).Select
Application.ScreenUpdating=True
  MsgBox "本文件夹的工作簿已汇总到本工作簿！" & Chr(10) & "汇总后的工作表名分别为：" _
  & Chr(10) & temp, vbOKOnly+64, "汇总完成"
End Sub
Sub sheetss(sh As Worksheet, biaoti As Byte)
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.ActiveSheet.Name=sh.Name
sh.Rows("1:" & biaoti).Copy ThisWorkbook.ActiveSheet.Cells(1, 1)
End Sub

5、用快捷键Alt+F8调出运行宏窗口，然后单击“执行”按钮，程序弹出提示框，提示输入各工作表标题行数