当前位置: 主页 > Office办公 > Excel专区 > Excel函数 > EXCEL如何使用VBA汇总当前路径下的工作簿的相应的工作表?

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

  • 2022-09-12
  • 来源/作者: Wps Office教程网/ 菜鸟图库
  • 282 次浏览

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

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

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

Sub test()
Dim WB As Workbook, WS As Worksheet, FN$, Rng As Range, k As Long
Application.ScreenUpdating = False
FN = Dir(ThisWorkbook.Path & "\*.xls*")
Application.AutomationSecurity = msoAutomationSecurityForceDisable
Do While FN <> ""
If FN <> ThisWorkbook.Name Then
Set WB = GetObject(ThisWorkbook.Path & "" & FN)
With WB
For Each WS In .Worksheets
If WS.Name Like "*出勤明细*" Then
With WS
i = .Cells(Rows.Count, 2).End(xlUp).Row
.Range("A2:D" & i).Copy
Set Rng = ThisWorkbook.Worksheets("加班原因汇总").Cells(ThisWorkbook.Worksheets("加班原因汇总").Rows.Count, 2).End(xlUp).Offset(1, 0)
With Rng
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteAll
End With
ThisWorkbook.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 = False
End With
End If
Next WS
End With
WB.Close False
End If
FN = Dir
Loop
Application.AutomationSecurity = msoAutomationSecurityByUI
End Sub