合并指定文件夹下的所有.xls文件

adders

Sub CombineWorkbooks()
   
    Dim CurFile As String
    Dim DestWB As Workbook
    Dim ws As Object
    Const DirLoc As String = "C:\" （改成你实际存放文件的folder）
    Application.ScreenUpdating = False
    Set DestWB = Workbooks.Add(xlWorksheet)
    CurFile = Dir(DirLoc & "*.xls") (.CSV，.PRN等格式类推）

    Do While CurFile <> vbNullString
        Dim OrigWB As Workbook
        Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)
        CurFile = Left(Left(CurFile, Len(CurFile) - 4), 29)

        For Each ws In OrigWB.Sheets
            ws.Copy After:=DestWB.Sheets(DestWB.Sheets.Count)
            If OrigWB.Sheets.Count > 1 Then
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile & ws.Index
            Else
                DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile
            End If
        Next

        OrigWB.Close SaveChanges:=False
        CurFile = Dir
    Loop

    Application.DisplayAlerts = False
        DestWB.Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Set DestWB = Nothing

End Sub

无聊的疯子

收藏了,慢慢研究!!

chengmba

下载学习，多谢分享，谢谢！

gfp12345678

收藏了

jhc553

收藏了

gfp12345678

收藏了

xsm1974

收藏了，以后有用。