得到以上结果

Sub t()

Dim str As String
Dim wb As Workbook

str = Dir("d:\data\*.xls*")

For i = 1 To 100
    Set wb = Workbooks.Open("d:\data\" & str)
    
    '将多表复制'
    wb.Sheets(1).Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    '并用其名字命名,需用split分隔，防止取到后缀名的情况'
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0)
    
    wb.Close
    str = Dir
    If str = "" Then
        Exit For
    End If
Next
End Sub

多表复制2

1
2

打开的表中还有三个表
命名格式为 北京1考场 ..

Sub t()

Dim str As String
Dim wk As Workbook
Dim sht As Worksheet

str = Dir("d:\data\*.xls*")

For i = 1 To 100
    Set wb = Workbooks.Open("d:\data\" & str)
    
        For Each sht In wb.Sheets
            sht.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Split(wb.Name, ".")(0) & sht.Name
        Next
    
    wb.Close
    str = Dir
    If str = "" Then
        Exit For
    End If
Next
End Sub

多表合并并汇总在一张表

1
2

将图1中的多张表合并在工作簿的一张表中，并在最后一列中标明城市

Sub t()

Dim str As String
Dim wb As Workbook
Dim i, j As Integer

str = Dir("d:\data\*.xls*")
For i = 2 To 100
    Set wb = Workbooks.Open("d:\data\" & str)
    '以上通用：依次打开每个文件'
    
    
    '处理此次任务的代码'
    'i 统计每次新打开表的行数'
    i = wb.Sheets(1).Range("a65536").End(xlUp).Row
    
    'j 统计汇总表当前的行数'
    j = ThisWorkbook.Sheets("数据").Range("a65536").End(xlUp).Row
    
    wb.Sheets(1).Range("a2:g" & i).Copy ThisWorkbook.Sheets("数据").Range("a" & j + 1)
    '汇总表的最边上一列写上城市名'
    ThisWorkbook.Sheets("数据").Range("h" & j + 1).Resize(i - 1, 1) = Split(wb.Name, ".")(0)
    
      
    
    '以下通用，打开完所有文件后退出for循环'
    wb.Close
    str = Dir
    If str = "" Then
        Exit For
    End If
Next
End Sub

新学函数Resize

Resize的用法
range("a1").resize(2,3)
意思是以a1为左上角单2行3列的数据