|
Sub zz()
Dim f$, p$, arr, brr
Application.ScreenUpdating = False
Sheet1.[a3:aj2000] = ""
Sheet2.[a3:aj2000] = ""
On Error Resume Next
p = ThisWorkbook.Path & "\明细表\"
f = Dir(p & "*.xls")
Do While Len(f)
If f <> ThisWorkbook.Name Then
With GetObject(p & f)
For i = 1 To .Sheets.Count
If .Sheets(i).Name = "行政机构人员信息" Then
arr = .Sheets(i).Range("A3:AJ" & .Sheets(i).[a65536].End(3).Row)
End If
If .Sheets(i).Name = "事业单位人员信息" Then
brr = .Sheets(i).Range("A3:AJ" & .Sheets(i).[a65536].End(3).Row)
End If
Next
.Close False
End With
With ThisWorkbook
.Sheets("行政机构人员信息").Range("A" & .Sheets("行政机构人员信息").[a65536].End(3).Row + 1).Resize(UBound(arr), UBound(arr, 2)) = arr
.Sheets("事业单位人员信息").Range("A" & .Sheets("事业单位人员信息").[a65536].End(3).Row + 1).Resize(UBound(brr), UBound(brr, 2)) = brr
End With
Erase arr: Erase brr
End If
f = Dir
Loop
Application.ScreenUpdating = True
End Sub
|
|