yhd-ExcelVBA一键汇总文件夹中多Excel简历信息到一个Excel文件中
上一次分享了一个汇总word文件的，现在分享一个汇总Excel文件的
======================
【问题】：公司招聘，有几百个来报名，报名表如下，我收集后要汇总在一个Excel文件中
====【常规作法】====
“打开~复制~粘贴~关闭~不保存”…………要几天重复的工作才做得完
====【目标】=====
一键完成
====【代码】====
Sub Macro1()
Dim wb As Workbook, myfile$, s&, i&, all_sht As Worksheet, column_arr, want_sht_name
Dim arr()
t = Timer
On Error Resume Next '如果遇到错误，不管错误，继续往下执行，但如果嵌套了其他错误处理语句，这些错误处理语句还是会按照自己规则运行
'On Error GoTo Err_Handle
Application.DisplayAlerts = False
Application.ScreenUpdating = False
myfile = Dir(ThisWorkbook.Path & "*.xls*")
Set all_sht = Worksheets("汇总")
column_arr = all_sht.Range("xfd3").End(xlToLeft).Column
ReDim arr(1 To 1000, 1 To column_arr)
want_sht_name = all_sht.Range("b1").Value
If want_sht_name = "" Then
MsgBox "请输入“要取数据的工作表名” "
Exit Sub
End If
'MsgBox column_arr
s = 0
Do While myfile <> ""
If ThisWorkbook.Name <> myfile Then
s = s 1
Set wb = GetObject(ThisWorkbook.Path & "" & myfile)
For Each SHT In wb.Worksheets
If SHT.Name = want_sht_name Then
arr(s, 1) = myfile '序号
With SHT
'MsgBox SHT.Name
For i = 2 To column_arr
arr(s, i) = .Range(all_sht.Cells(2, i))
Next i
End With
End If
Next
wb.Close False
Set wb = Nothing
End If
myfile = Dir
Loop
On Error GoTo 0 '结束错误捕捉
all_sht.Range("a4:y1000").ClearComments
all_sht.Cells.NumberFormat = "@"
all_sht.Range("a4").Resize(s, UBound(arr, 2)) = arr
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "汇总文件数为：" & s & Chr(10) & "时间为：" & Timer - t
Exit Sub
'Err_Handle:
'MsgBox "读不了的错误文件为：" & myfile & Chr(10) & "移到其他文件夹，再运行！"
End Sub
==【使用方法】===
把要取得的工作表名:“Sheet1”
要取的数据所在的单元格：如B2 D2 F2……
填写在汇总表中：如下
===【运行~~成功】===
