某單位組織一次大型會議,要求各參會單位填寫好會議回執后傳回,再進行匯總。回執是用Excel制作的,有一個統一的標題行。由于參會單位和參會人員眾多,返回的Excel文件很多,手工逐一匯總比較麻煩。這時用VBA可快速解決問題,示例文件下載 示例文件
如圖所示,會議回執在工作簿的第一個工作表中,參會人員信息從第4行開始填寫,共5列,各個單位的參會人員可能不同。匯總工作簿與回執工作簿具有相同的行標題。
將所有收到的回執和匯總工作簿放到某個文件夾中,注意該文件夾內不能包含其他非回執Excel文件,打開匯總工作簿并選擇匯總工作表,按Alt+F11,在VBA編輯器中單擊菜單“插入→模塊”,將下列代碼粘貼到代碼窗口內執行,即可將所有回執工作簿第一個工作表中的人員信息自動復制到匯總工作簿的第一個工作表。
Sub 回執匯總()
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)
‘復制有內容的分表數據到匯總表
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
‘當前文件夾內的下一個工作簿
TheFile = Dir
Loop
Application.ScreenUpdating = True
End Sub