900字范文,内容丰富有趣,生活中的好帮手!
900字范文 > VBA 合并同文件夹下多工作簿中同名工作表到 一工作簿一工作表

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

时间:2023-07-29 02:17:51

相关推荐

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

学习日志

批量合并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

本内容不代表本网观点和政治立场,如有侵犯你的权益请联系我们处理。
网友评论
网友评论仅供其表达个人看法,并不表明网站立场。