某單位組織一次大型會(huì)議，要求各參會(huì)單位填寫好會(huì)議回執(zhí)后傳回，再進(jìn)行匯總。回執(zhí)是用Excel制作的，有一個(gè)統(tǒng)一的標(biāo)題行。由于參會(huì)單位和參會(huì)人員眾多，返回的Excel文件很多，手工逐一匯總比較麻煩。這時(shí)用VBA可快速解決問題，示例文件下載 示例文件
如圖所示，會(huì)議回執(zhí)在工作簿的第一個(gè)工作表中，參會(huì)人員信息從第4行開始填寫，共5列，各個(gè)單位的參會(huì)人員可能不同。匯總工作簿與回執(zhí)工作簿具有相同的行標(biāo)題。
將所有收到的回執(zhí)和匯總工作簿放到某個(gè)文件夾中，注意該文件夾內(nèi)不能包含其他非回執(zhí)Excel文件，打開匯總工作簿并選擇匯總工作表，按Alt+F11，在VBA編輯器中單擊菜單“插入→模塊”，將下列代碼粘貼到代碼窗口內(nèi)執(zhí)行，即可將所有回執(zhí)工作簿第一個(gè)工作表中的人員信息自動(dòng)復(fù)制到匯總工作簿的第一個(gè)工作表。
Sub 回執(zhí)匯總()
Dim ThePath As String, TheFile As String
Dim Wbk As Workbook
On Error Resume Next
Application.ScreenUpdating = False
Range("A4:F65536").ClearContents
ThePath = ThisWorkbook.Path & "\"
TheFile = Dir(ThePath & "*.xls")
Do While TheFile <> ""
If TheFile <> ThisWorkbook.Name Then
Set Wbk = GetObject(ThePath & TheFile)
With Wbk.Worksheets(1)
‘復(fù)制有內(nèi)容的分表數(shù)據(jù)到匯總表
If .[a65536].End(xlUp).Row > 3 Then
.Range("A4:E" & .[a65536].End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).[a65536].End(xlUp).Offset(1)
End If
End With
Wbk.Close False
End If
‘當(dāng)前文件夾內(nèi)的下一個(gè)工作簿
TheFile = Dir
Loop
Application.ScreenUpdating = True
End Sub
