|
|
Sub 合并()
Application.ScreenUpdating = False
Set sh = ThisWorkbook.Worksheets(1)
sh.[a1].CurrentRegion.Offset(1) = Empty
f = Dir(ThisWorkbook.Path & "\*.xls*")
Do While f <> ""
If f <> ThisWorkbook.Name Then
Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & f, 0)
With wb.Worksheets(1)
r = .Cells(Rows.Count, 8).End(xlUp).Row
ar = .Range("h1:h" & r)
rs = rs + 1
sh.Cells(1, rs).Resize(UBound(ar), UBound(ar, 2)) = ar
End With
wb.Close False
End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub |
|
