|
Sub 按钮2_单击()
Dim n&, i&, j&, arr, Myname$, Mypath$, Wb As Workbook, Sht As Worksheet, n1%, n2%
Application.DisplayAlerts = False
ActiveSheet.UsedRange.Offset(1).ClearContents
Mypath = ThisWorkbook.Path & "\"
Myname = Dir(Mypath & "*.xlsx")
n1 = 2
Do While Myname <> ""
If Myname <> ThisWorkbook.Name Then
Set Wb = Workbooks.Open(Mypath & Myname)
For Each Sht In Wb.Sheets
arr = Sht.Range("A3:Y" & Wb.Sheets(1).Range("A65536").End(3).Row)
n = ThisWorkbook.Sheets(1).Range("C65536").End(3).Row + 1
ThisWorkbook.Sheets(1).Cells(n, "C").Resize(UBound(arr), UBound(arr, 2)) = arr
n2 = ThisWorkbook.Sheets(1).Range("C65536").End(3).Row
ThisWorkbook.Sheets(1).Range("A" & n & ":A" & n2) = Myname
ThisWorkbook.Sheets(1).Range("B" & n & ":B" & n2) = Sht.Name
n1 = n2 + 1
Next
Wb.Close
End If
Myname = Dir
Loop
Application.DisplayAlerts = True
End Sub
|
|