员工简历简单信息汇总信息

小白染墨

公司最近几年规模扩大很快，员工信息长久没有更新，于是下发了一个简易简历表格汇总更新员工信息
刚开始学习VBA语言怎么也搞不定，希望有老师能来指导一下。谢谢。
附件说明

附件里有一个汇总表，还有3个员工信息表格，希望能把每个单独的员工信息表里面的信息汇总到对应总表单元格内

小白染墨

自己顶一下_(:з」∠)_

uynayna

Sub 汇总数据()
    Application.ScreenUpdating = False
    Dim wb, wb1 As Excel.Workbook
    Dim sh As Excel.Worksheet
    Dim d, arr
    Set d = CreateObject("scripting.dictionary")
    f = Dir(ThisWorkbook.Path & "\*" & "xl*") '生成查找EXCEL的目录
    Do While f <> "" '在目录中循环
            If f <> ThisWorkbook.Name Then  '如果不是打开的工作簿
                Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f)
                For Each sht In wb.Sheets '遍历打开文件的每一张表格
                    With ActiveSheet.Range("a1:b200")
                        Set Rng = .Find("姓名")
                    End With
                    If Not Rng Is Nothing Then
                        arr = WorksheetFunction.Transpose(Range("b2:b24"))
                    End If
                Next sht
                wb.Close
                With ThisWorkbook.Sheets(1)
                    r = .Range("b65536").End(xlUp).Row + 1
                    Cells(r, 1) = r - 1
                    For i = 1 To 23
                    .Cells(r, i + 1) = arr(i)
                    Next
                End With
            End If
        f = Dir
    Loop
    Application.ScreenUpdating = True
End Sub