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

<>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.WorksheetsIf 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

• « 上一篇：Python排列函数和组合函数
• » 下一篇：【C/C++】输入数据个数未知情况下输入方法