因为有人询问合并计算，对VBA略知一些，我就写了一点，有需要的人可以借鉴。

新建一个工作表，粘贴到模块，F5运行，就可以达到左列合计，左列为一列。

下面是代码：

无源数据格式

Sub 多工作簿合计()
Application.ScreenUpdating = False
Dim Wb As Workbook, vrtSelectedItem As Variant, Mysheet As Worksheet, CellAddress
Dim ShRan As String, Arr() As String, s As Long, Spt, NewPath As String, Bool As Boolean
On Error Resume Next '遇到错误继续执行
With Application.FileDialog(msoFileDialogFilePicker)
   .AllowMultiSelect = True
   '多选
  .InitialFileName = ThisWorkbook.Path & "\"
  '默认路径
  .Title = "选择文件"
  '窗口标题
  .Filters.Clear
   '清除文件过滤器
  .Filters.Add "全部文件", "*.*"
  .Filters.Add "Excel文件", "*.xlsm"
  .Filters.Add "Excel文件", "*.xls"
  .Filters.Add "Excel文件", "*.xlsx;*.xls"
   '设置文件过滤器，可以指定多个扩展名，每个扩展名都必须用分号分隔。 例如，可以将参数分配给字符串：".txt;.htm"。
  Cells.Clear
  Bool = True
  If .Show = -1 Then
    For Each vrtSelectedItem In .SelectedItems
      Spt = Split(vrtSelectedItem, "\")
      NewPath = "'" & Replace(vrtSelectedItem, Spt(UBound(Spt)), "[" & Spt(UBound(Spt)) & "]")
      Set Wb = Workbooks.Open(vrtSelectedItem)
      For Each Mysheet In Wb.Worksheets
        '复制标题行，不带格式粘贴
        If Bool Then
          Mysheet.Rows("1:1").Copy
          Cells(1, 1).PasteSpecial Paste:=xlPasteValues
          Bool = False
          Application.CutCopyMode = False
        End If
        ReDim Preserve Arr(s)
        '获取不包含首行的当前区域
        CellAddress = Split(Mysheet.Cells(2, 1).CurrentRegion.Address, ":")
        ShRan = Mysheet.Name & "'!" & Mysheet.Range("A2：" & CellAddress(1)).Address(ReferenceStyle:=xlR1C1) '数据区域
        Arr(s) = NewPath & ShRan
        s = s + 1
      Next Mysheet
      Wb.Close
    Next vrtSelectedItem
    Set Wb = Nothing
  End If
End With
Range("A2").Consolidate Sources:=Arr, Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False
Application.ScreenUpdating = True
End Sub

下面是有源数据格式的

Sub 汇总合计() '保留源数据格式
Application.ScreenUpdating = False
Dim Wb As Workbook, vrtSelectedItem, Mysheet As Worksheet, i As Long, Bool As Boolean, Start_row
'On Error Resume Next '容错
With Application.FileDialog(msoFileDialogFilePicker)
  .AllowMultiSelect = True
   '多选
  .InitialFileName = ThisWorkbook.Path & "\"
  '默认路径
  .Title = "选择文件"
  '窗口标题
  .Filters.Clear
   '清除文件过滤器
  .Filters.Add "全部文件", "*.*"
  .Filters.Add "Excel文件", "*.xlsx;*.xls" '可以指定多个扩展名，每个扩展名都必须用分号分隔。 例如，可以将参数分配给字符串：".txt;.htm"。
  .Filters.Add "Excel文件", "*.xlsm"
  .Filters.Add "Excel文件", "*.xls"
  '设置文件过滤器
  
  Cells.Clear
  Bool = True
  If .Show = -1 Then
    For Each vrtSelectedItem In .SelectedItems
      Set Wb = Workbooks.Open(vrtSelectedItem)
      With ThisWorkbook.ActiveSheet
        For Each Mysheet In Wb.Worksheets
          If Bool = True Then Start_row = 1 Else Start_row = 2: Bool = False
          '获取不包含首行的当前区域
          CellAddress = Split(Mysheet.Cells(1, 1).CurrentRegion.Address, ":")
          Mysheet.Range("A" & Start_row & "：" & CellAddress(1)).Copy .Cells(i + 1, 1)
          
          i = Mysheet.Range("A1").CurrentRegion.Rows.Count
        Next
      End With
      Wb.Close
    Next
    Set Wb = Nothing
  End If
End With

Dim RowCount As Long, MyRange As String, ColCount As Long, DataCol As Long, E_Coords, Act_sh

With ThisWorkbook.ActiveSheet
    RowCount = .Cells(Rows.Count, 2).End(xlUp).Row
    ColCount = .Cells(1, 1).CurrentRegion.Columns.Count
    Act_sh = .Cells(1, 1).CurrentRegion.Address
    .Range(Act_sh).Copy
        With .Cells(1, ColCount + 1)
           .PasteSpecial Paste:=xlPasteColumnWidths
           .PasteSpecial Paste:=xlPasteFormats
        End With
    Application.CutCopyMode = False
    E_Coords = Split(Act_sh, ":")(1)
    MyRange = ActiveSheet.Name & "!" & .Range("A2:" & E_Coords).Address(ReferenceStyle:=xlR1C1)
    .Cells(2, ColCount + 1).Consolidate Sources:=MyRange, _
            Function:=xlSum, TopRow:=False, LeftColumn:=True, CreateLinks:=False
            
    .Range("A2:" & E_Coords).Delete Shift:=xlToLeft
  
    .Range(Range("A1").CurrentRegion.Rows.Count + 1 & ":" & .Cells.Rows.Count).ClearFormats
End With
Application.ScreenUpdating = True
End Sub

VBA学习笔记3：合并同一工作簿下的多个表格

1、建立一个新的汇总表；
2、将其他sheet数据复制到汇总表中。

效果如下：
需要将3个sheet的表的数据汇总起来

汇总后的数据：

代码如下：

Sub 合并多个工作表数据()
    Dim sht As Worksheet
    Dim rows%, hzrows%  ’row存储被复制的sheet的行数，hzrow存储新建表的行数
    ThisWorkbook.Worksheets().Add(before:=ThisWorkbook.Worksheets("1月")).Name = "汇总" 'worksheets.add.name="" 在1月sheet前创建工作表并重命名为“汇总”
    [a1] = "月份"
    [b1] = "姓名"
    [c1] = "成绩"
    For Each sht In Worksheets '循环
        If sht.Name <> ActiveSheet.Name  Then ‘除“汇总”外所有的表都要复制过来
            rows = WorksheetFunction.CountA(sht.[a:a]) 'sheet中a列不为空的行数（注意a列不要有空值）
            hzrows = WorksheetFunction.CountA(ActiveSheet.[a:a]) '“汇总”中的行数（新建表“汇总”即activesheet，也可用worksheets("汇总")替代activesheet）
            sht.Range("a2:b" & rows).Copy ActiveSheet.Range("b" & hzrows + 1) ’将sht的a2及以后的数据复制，粘贴只“汇总”的b列的第一个空行
            Range(Cells(hzrows + 1, 1), Cells(hzrows + rows - 1, 1)) = sht.Name '将sht的表名作为“汇总”的a列值 （从第一份非空行开始，到两个表非空行数-1)
        End If
    Next sht
End Sub

也可以手工新建“汇总”表后插入按钮，效果如下：

Private Sub CommandButton1_Click()
    ActiveSheet.Range("1:1045876").ClearContents '清空工作簿
    Dim sht As Worksheet
    Dim rows%, hzrows%
    [a1] = "月份"
    [b1] = "姓名"
    [c1] = "成绩"
    For Each sht In Worksheets
        If sht.Name <> ActiveSheet.Name Then
            rows = WorksheetFunction.CountA(sht.[a:a])
            hzrows = WorksheetFunction.CountA(ActiveSheet.[a:a])
            sht.Range("a2:b" & rows).Copy Range("b" & hzrows + 1)
            Range(Cells(hzrows + 1, 1), Cells(hzrows + rows - 1, 1)) = sht.Name
        End If
    Next sht
End Sub

参考：
VBA 合并同文件夹下多工作簿中同名工作表到 一工作簿一工作表

2022/1/19 更新
跳过不含指定sheet的工作薄并汇总。

Sub Build_Sheet_List()
    Dim sht As Worksheet, i As Long, strName As String
    With Columns(1)
        .Clear '清空A列数据
        .NumberFormat = "@" '设置文本格式
    End With
    For i = 1 To Sheets.Count '索引法遍历工作表集合
        strName = Sheets(i).Name '表名
        Cells(i, 1).Value = strName
        ActiveSheet.Hyperlinks.Add anchor:=Cells(i, 1), Address:="", _
                SubAddress:="'" & strName & "'!a1", TextToDisplay:=strName
    Next
End Sub

Sub all_excel_files()
    Dim path As String, filename As String
    Dim w As Workbook, ws As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
    '-------------------取得用户选择的文件夹路径---------------------------
    If .Show Then path = .SelectedItems(1) Else Exit Sub
    End With
    If Right(path, 1) <> "\" Then path = path & "\"
    filename = Dir(path & "\*.xls*")
    Application.DisplayAlerts = False
    '-------------------取得用户选择的合并工作表名---------------------------
    strKey = InputBox("请输入需要合并的工作表名：", "提醒")
    If StrPtr(strKey) = 0 Then Exit Sub
    '-----------打开指定文件夹下的工作薄，复制粘贴工作表到汇总表，重命名--------------------
    Set ws = Workbooks.Add
    Do While filename <> ""
        'w代表指定文件夹下每个找到的excel文件
        Set w = Workbooks.Open(path & "\" & filename)
            '选择工作表，复制，并粘贴为汇总表的最后一张
          If strKey = ActiveSheet.Name Then
                w.Sheets(strKey).Copy after:=ws.Sheets(ws.Sheets.Count)
               ' 重命名刚贴的表名为excel文件名
                If Right(filename, 4) = "xls*" Then ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 4) Else ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 5)
            End If
        ' 关闭工作簿
        w.Close
        '下一个
        filename = Dir
    Loop
    '-----------制作目录工作表--------------------
    Sheets("Sheet1").Name = "目录"
    Sheets("目录").Select
    Call Build_Sheet_List
    Application.DisplayAlerts = True
    ws.SaveAs path & "\汇总.xlsx"
End Sub

将所汇总的数据逐个添加到同一工作表中见下载链接：
https://download.csdn.net/download/weixin_42750611/76744062
效果如下：

2020/8/10
在原先代码的基础上修改，可以自由选择和输入要合并多工作簿的同文件夹和工作表名，并生成目录页。
效果展示：
1、选择工作表

2、输入指定相同工作表名

3、等待程序执行完毕。
代码如下：

Sub Build_Sheet_List()
    Dim sht As Worksheet, i As Long, strName As String
    With Columns(1)
        .Clear '清空A列数据
        .NumberFormat = "@" '设置文本格式
    End With
    For i = 1 To Sheets.Count '索引法遍历工作表集合
        strName = Sheets(i).Name '表名
        Cells(i, 1).Value = strName
        ActiveSheet.Hyperlinks.Add anchor:=Cells(i, 1), Address:="", _
                SubAddress:="'" & strName & "'!a1", TextToDisplay:=strName
    Next
End Sub

Sub all_excel_files()
    Dim path As String, filename As String
    Dim w As Workbook, ws As Workbook
    With Application.FileDialog(msoFileDialogFolderPicker)
    '-------------------取得用户选择的文件夹路径---------------------------
    If .Show Then path = .SelectedItems(1) Else Exit Sub
    End With
    If Right(path, 1) <> "\" Then path = path & "\"
    filename = Dir(path & "\*.xls")
    Application.DisplayAlerts = False
    '-------------------取得用户选择的合并工作表名---------------------------
    strKey = InputBox("请输入需要合并的工作表名：", "提醒")
    If StrPtr(strKey) = 0 Then Exit Sub
    '-----------打开指定文件夹下的工作薄，复制粘贴工作表到汇总表，重命名--------------------
    Set ws = Workbooks.Add
    Do While filename <> ""
        'w代表指定文件夹下每个找到的excel文件
        Set w = Workbooks.Open(path & "\" & filename)
            '选择工作表，复制，并粘贴为汇总表的最后一张
            If strKey <> ActiveSheet.Name Then w.Close
            If strKey <> ActiveSheet.Name Then MsgBox "该文件夹内存在不含指定工作表名的工作薄，请重新检查！", 64, "提示": Exit Sub
            w.Sheets(strKey).Copy after:=ws.Sheets(ws.Sheets.Count)
             '重命名刚贴的表名为excel文件名
            If Right(filename, 4) = ".xls" Then ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 4) Else ws.Worksheets(ws.Sheets.Count).Name = Mid(filename, 1, Len(filename) - 5)
        '关闭工作簿
        w.Close
        '下一个
        filename = Dir
    Loop
    '-----------制作目录工作表--------------------
    Sheets("Sheet1").Name = "目录"
    Sheets("目录").Select
    Call Build_Sheet_List
    Application.DisplayAlerts = True
    ws.SaveAs path & "\汇总.xlsx"
End Sub

小提示：
1、如果只想打开文件夹内的xlsx文件filename = Dir(path & "\*.xls")改为filename = Dir(path & "\*.xlsx*")可以同时打开文件夹中的xls文件。