[已解决]合并多个excel文件

gumingjian

zjdh 发表于 2014-2-27 15:30
一定是那个文件有特殊情况！！
将那个文件上传看看。

谢谢，请您帮忙分析一下。

zjdh

原来是表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
多工作簿多表汇总.rar (58.6 KB, 下载次数: 10)

2014-2-27 21:38 上传

点击文件名下载附件

376383341

学习

gumingjian

zjdh 发表于 2014-2-27 21:38
原来是表2没有数据！修改如下：
Sub TEST()
    Application.ScreenUpdating = False

非常感谢！[em17]

gumingjian

王谦 发表于 2014-2-27 07:31
[/td][/tr]
[tr][/tr]
[/table]

谢谢您的帮忙