一個論壇上的會員有如下的要求：如圖需要把當前路徑中的財務、采購、工廠、計劃、人士等工作簿的“出勤明細”工作表的記錄復制匯總在“加班匯總表”工作簿中的“加班原因匯總”工作表中，并需要取出各部門的名稱，希望批量使用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
