一個(gè)論壇上的會(huì)員有如下的要求：如圖需要把當(dāng)前路徑中的財(cái)務(wù)、采購(gòu)、工廠、計(jì)劃、人士等工作簿的“出勤明細(xì)”工作表的記錄復(fù)制匯總在“加班匯總表”工作簿中的“加班原因匯總”工作表中，并需要取出各部門(mén)的名稱，希望批量使用VBA完成？很久沒(méi)有玩VBA了，今晚手癢，寫(xiě)了這樣一個(gè)程序：
A：ALT+F11>>>插入模塊>>>模塊中輸入以下代碼：
EXCEL如何使用VBA匯總當(dāng)前路徑下的工作簿的相應(yīng)的工作表？
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 "*出勤明細(xì)*" 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
