EXCEL如何使用VBA汇总当前路径下的工作簿的相应的工作表？

EXCEL如何使用VBA汇总当前路径下的工作簿的相应的工作表？

一个论坛上的会员有如下的要求：如图需要把当前路径中的财务、采购、工厂、计划、人士等工作簿的“出勤明细”工作表的记录复制汇总在“加班汇总表”工作簿中的“加班原因汇总”工作表中，并需要取出各部门的名称，希望批量使用VBA完成？很久没有玩VBA了，今晚手痒，写了这样一个程序：

A：ALT+F11>>>插入模块>>>模块中输入以下代码：

EXCEL如何使用VBA汇总当前路径下的工作簿的相应的工作表？

Sub test()Dim WB As Workbook, WS As Worksheet, FN$, Rng As Range, k As LongApplication.ScreenUpdating = FalseFN = Dir(ThisWorkbook.Path & "\*.xls*")Application.AutomationSecurity = msoAutomationSecurityForceDisableDo While FN <> ""If FN <> ThisWorkbook.Name ThenSet WB = GetObject(ThisWorkbook.Path & "" & FN)With WBFor Each WS In .WorksheetsIf WS.Name Like "*出勤明细*" ThenWith WSi = .Cells(Rows.Count, 2).End(xlUp).Row.Range("A2:D" & i).CopySet Rng = ThisWorkbook.Worksheets("加班原因汇总").Cells(ThisWorkbook.Worksheets("加班原因汇总").Rows.Count, 2).End(xlUp).Offset(1, 0)With Rng.PasteSpecial xlPasteFormats.PasteSpecial xlPasteAllEnd WithThisWorkbook.Worksheets("加班原因汇总").Cells(ThisWorkbook.Worksheets("加班原因汇总").Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(i – 1, 1) = Left(WB.Name, Len(WB.Name) – 4)Application.CutCopyMode = FalseEnd WithEnd IfNext WSEnd WithWB.Close FalseEnd IfFN = DirLoopApplication.AutomationSecurity = msoAutomationSecurityByUIEnd Sub

版权声明：本文内容由网络用户投稿，版权归原作者所有，本站不拥有其著作权，亦不承担相应法律责任。如果您发现本站中有涉嫌抄袭或描述失实的内容，请联系我们jiasou666@gmail.com 处理，核实后本网站将在24小时内删除侵权内容。