原来是表2没有数据!修改如下:
Sub TEST()
Application.ScreenUpdating = False
For Each ST In Sheets '清除记录
If ST.Cells(1, 1).MergeCells Then
ST.UsedRange.Offset(2, 0).ClearContents
Else
ST.UsedRange.Offset(1, 0).ClearContents
End If
Next
MyPath = ThisWorkbook.Path
MYFILE = Dir(MyPath & "\*.xls")
J = ThisWorkbook.Sheets.Count
Do Until MYFILE = ""
If MYFILE <> ThisWorkbook.Name Then
Set FS = Workbooks.Open(MyPath & "\" & MYFILE)
For I = 1 To J '复制数据
With FS.Sheets(I)
If .Cells(1, 1).MergeCells Then
.Range("A3:Y" & .Range("A65536").End(3).Row + 1).Copy ThisWorkbook.Sheets(I).Range("A65536").End(3)(3)
Else
.Range("A2:Y" & .Range("A65536").End(3).Row).Copy ThisWorkbook.Sheets(I).Range("A65536").End(3)(2)
End If
End With
Next
FS.Close
End If
MYFILE = Dir
Loop
For I = 1 To J '清除空行
With Sheets(I)
For J = .Range("A65536").End(3).Row To 3 Step -1
If .Cells(J, 1) = "" Then .Rows(J).Delete
Next
End With
Next
Application.ScreenUpdating = True
End Sub
(, 下载次数: 10)