学习日志
批量合并excel工作簿中同名工作表,适用条件:
1、所有要汇总的工作簿在同一个文件夹中,这里以后缀为.xlsx为例;
2、需要合并的工作表名称相同(如: “sheet1”),且数据字段一样(如:A列表示序号,B列表示姓名,C列表示月工资等,本例中指定数据位于a-c列);
3、需要合并的数据所在区域起始行列一致(如:有相同的表头)
ALL IN ONE
Sub allinone()Dim path As String, filename As StringDim ws As Workbook, w As WorkbookDim starrow As Long, n As Long, r As Long, titlerow As Integerpath = "C:\Users\Lee\Desktop\新建文件夹\全民一起VBA 提高篇\12"filename = Dir(path & "\*.xlsx")Set ws = Workbooks.Add'每次复制时开始的行数starrow = 1: n = 0: titlerow = 1Application.DisplayAlerts = FalseDo While filename <> ""Set w = Workbooks.Open(path & "\" & filename)n = n + 1'以下复制分表数据,第一张含表头,其他表格只复制数据区With w.Worksheets("sheet1")'xlCellTypeLastCell 可用11代替'Cells.SpecialCells(11).Row 包含字符的最后一个单元格所在行号r = Cells.SpecialCells(xlCellTypeLastCell).RowIf n = 1 Then.Range("a1", "c" & r).SelectElse.Range("a" & (titlerow + 1), "c" & r).SelectEnd IfEnd WithSelection.Copyw.CloseWith ws.Worksheets("sheet1").Range("b" & starrow).Select.Paste.Range("a" & starrow, "a" & (starrow + r - titlerow)) = Mid(filename, 1, Len(filename) - 5)End With'复制完后,根据B列中最后数据所在行号,重定义下次复制数据开始行号'.End(xlUp).Row指数据区域最后一行行号starrow = Range("b" & Rows.Count).End(xlUp).Row + 1filename = DirLoopWith ws.Worksheets("sheet1").Range("a1", "a" & titlerow) = "".Range("a" & Rows.Count).End(xlUp).value = ""End WithApplication.DisplayAlerts = Truews.SaveAs path & "\合并2.xlsx"End Sub