VBA学习笔记4：将同一文件下的多个工作簿的数据汇总为一个工作表

1、删除新建的工作簿中除“汇总表”外的其他工作表；
2、遍历文件夹下的其他工作簿，并将每个工作簿的工作表复制到“汇总表”和新建表的其他sheet中。

效果如下：
同一文件夹中有多个工作簿，需要将工作簿的数据汇总在一个表中，并生成一个汇总表。

运行前：

运行后：

代码如下：

Sub 汇总同一文件下的工作簿数据()
    Dim file$ '用来存储文件夹下的工作簿名称
    Dim sht As Worksheet '用来存储各个工作簿中待复制的工作表，下称“各表”
    Dim rng As Range '用来存储各表待复制区域
    Dim k% 'k记录各表的行数
    Dim nk% 'nk记录行数
    Dim m% 'm为当前工作簿中表的个数
    
    '删除新建的工作簿除“汇总表”外的其他sheet
    For Each sht In ThisWorkbook.Worksheets
        If sht.Name <> "汇总表" Then
            Application.DisplayAlerts = False
            sht.Delete
            Application.DisplayAlerts = True
        End If
    Next sht
    
   '设置初始值
    m = m + 1 '工作簿只有1个表
    Cells.Clear '清空数据
    [a1] = "班级": [b1] = "姓名": [c1] = "语文": [d1] = "数学": [e1] = "英语"
    file = Dir(ThisWorkbook.Path & "\*.xlsx")  '仅读取xlsx格式的文件
    '以下是将文件夹中的数据簿复制到一个工作簿的不同表中
    
    Do While file <> ""
        Workbooks.Open ThisWorkbook.Path & "\" & file
        Set sht = ActiveWorkbook.Worksheets(1) '打开后各表成为活动工作簿，sht存储这些工作簿的第一个工作表（假设这些数据都存在第一个表)
        k = WorksheetFunction.CountA(sht.[a:a]) 'k为各表的行数
        Set rng = sht.Range("a2:d" & k) 'rng为要复制的区域，rng为对象，一定要用set赋值
        nk = WorksheetFunction.CountA(ThisWorkbook.Worksheets("汇总表").[a:a]) 'nk为Sheet1表的行数
        rng.Copy ThisWorkbook.Worksheets("汇总表").Cells(nk + 1, 2) '粘贴到sheet1表，粘贴的起始单元格为nk+1行
        ThisWorkbook.Worksheets("汇总表").Range(Cells(nk + 1, 1), Cells(nk + 1, 1)(k - 1, 1)) = Replace(file, ".xlsx", "") '从a列的nk+1行开始赋值，赋值的行数是k-1，cells(m,n)(k,s)是指的以m行n列为首，向下移动k-1行n-1列,如果k=1,s=1则表示不变
        sht.Copy after:=ThisWorkbook.Worksheets(m) '将sht复制到现有sheet的后面，worksheets(1),worksheets(2)指的按照顺序的第一、二个工作表；sheet1是指我们在工作簿建表时的顺序，如果表被删除，则sheet1就不存在了，但是worksheets(1)是存在的
        ActiveSheet.Name = Replace(file, ".xlsx", "") '将新建的sheet重命名
        Workbooks(ThisWorkbook.Path & "\" & file).Close '关闭各表
        m = m + 1
        file = Dir
    Loop
End Sub