Sub 合并()
Dim i As Integer
Dim path As String, pathxx As String
Dim Filename As String
Application.ScreenUpdating = False
twna = ThisWorkbook.Name
pathxx = ThisWorkbook.path
path = ThisWorkbook.path & "\*.xls"
Filename = Dir(path)
Do
If Filename <> ThisWorkbook.Name Then
i = i + 1
Range("Ad" & i) = Filename
End If
Filename = Dir
Loop Until Filename = ""
For i = 1 To [ad65536].End(3).Row
bgmc = Range("ad" & i)
Workbooks.Open Filename:=pathxx & "\" & bgmc
Sheets(1).Select
Range("a2:ab" & [b65536].End(3).Row).Copy
Windows(twna).Activate
Range("a" & [b65536].End(3).Row + 1).Select
ActiveSheet.Paste
Windows(bgmc).Activate
Application.CutCopyMode = False
ActiveWindow.Close
Next
[ad:ad].ClearContents
Application.ScreenUpdating = True
[a1].Select
End Sub
Sub 合并()
Dim i As Integer
Dim path As String, pathxx As String
Dim Filename As String
Application.ScreenUpdating = False
twna = ThisWorkbook.Name
pathxx = ThisWorkbook.path
path = ThisWorkbook.path & "\*.xls"
Filename = Dir(path)
Do
If Filename <> ThisWorkbook.Name Then
i = i + 1
Range("Ad" & i) = Filename
End If
Filename = Dir
Loop Until Filename = ""
For i = 1 To [ad65536].End(3).Row
bgmc = Range("ad" & i)
Workbooks.Open Filename:=pathxx & "\" & bgmc
Sheets(1).Select
Range("a2:ab" & [b65536].End(3).Row).Copy
Windows(twna).Activate
Range("a" & [b65536].End(3).Row + 1).Select
ActiveSheet.Paste
Windows(bgmc).Activate
Application.CutCopyMode = False
ActiveWindow.Close
Next
[ad:ad].ClearContents
Application.ScreenUpdating = True
[a1].Select
End Sub