合并Excel工作簿-合并到不同工作表和同一个工作表

在职场偶尔会有将多个Excel文件合并到同一个Excel文件的需求。这个需求可能又分两种，一种是合并到同一个Excel文件中的同一个工作表中，另一种是合并到同一个Excel文件中的不同工作表。以下Excel VBA代码就可实现 以上这些功能： 让用户选择一个指定的文件夹，程序可将指定文件夹下面所有Excel文件合并到一个汇总的Excel文件中
实现效果（为简单，在选择的文件夹下只放了2个工作簿）：
原表1：

1480599559128492.jpg

原表2：

1480599559101511.jpg

合并后效果1：

1480599654683861.jpg

合并后效果2：

1480599654387974.jpg

作者1：Excel小子-Office中国
Sub PickFolder()      '** 使用Shell.Application对象来选择文件夹    Dim objShell    Dim objFolder    Dim strPath As String    Dim ph As String    Dim wk As Workbook, wb As Workbook    Dim sh As Worksheet    Application.ScreenUpdating = False    Application.DisplayAlerts = False    Set objShell = CreateObject("Shell.Application")        '** 显示选择文件夹对话框    Set objFolder = objShell.BrowseForFolder(0, "选择文件目录", 0, 0)       If Not objFolder Is Nothing Then     '** 用户选择了文件夹      strPath = objFolder.self.Path      Set wb = Workbooks.Add      ph = Dir(strPath & "\" & "*.xls*")      Do While ph  ""        Set wk = Workbooks.Open(strPath & "\" & ph)        For Each sh In wk.Worksheets          sh.Copy after:=wb.Worksheets(wb.Worksheets.Count)        Next sh        wk.Close False        ph = Dir           Loop      For Each sh In wb.Worksheets        If WorksheetFunction.CountA(sh.UsedRange) = 0 Then          sh.Delete        End If           Next sh      wb.SaveAs ThisWorkbook.Path & "\合并文档.xlsx"      wb.Close    Else      strPath = ""    End If       Set objFolder = Nothing    Set objShell = Nothing    Application.DisplayAlerts = True    Application.ScreenUpdating = TrueEnd Sub
作者2：江苏大侠- Office中国 （对以上代码改进）
Sub PickFolder()  Dim strPath As String  Dim ph As String  Dim wk As Workbook, wb As Workbook  Dim sh As Worksheet  Application.ScreenUpdating = False  Application.DisplayAlerts = False  With Application.FileDialog(msoFileDialogFolderPicker)    If .Show = -1 Then      strPath = .SelectedItems(1) & "\"      Else      Exit Sub    End If  End With  Set wb = Workbooks.Add(xlWorksheet)  ph = Dir(strPath & "\" & "*.xlsx")  Do While ph  ""    Set wk = Workbooks.Open(strPath & "\" & ph)    For Each sh In wk.Worksheets      sh.Copy After:=wb.Sheets(wb.Sheets.Count)    Next sh    wk.Close False    ph = Dir  Loop  wb.Sheets(1).Delete  wb.SaveAs ThisWorkbook.Path & "\合并文档.xlsx"  ' wb.Close  Application.DisplayAlerts = True  Application.ScreenUpdating = TrueEnd Sub
作者3：江苏大侠- Office中国 （合并到同一个工作表中）
Sub PickFolder()  Dim strPath As String  Dim ph As String  Dim wk As Workbook, wb As Workbook  Dim sh As Worksheet  Application.ScreenUpdating = False  Application.DisplayAlerts = False  With Application.FileDialog(msoFileDialogFolderPicker)    If .Show = -1 Then      strPath = .SelectedItems(1) & "\"      Else      Exit Sub    End If  End With  Set wb = Workbooks.Add(xlWorksheet)  ph = Dir(strPath & "\" & "*.xls*")  Do While ph  ""    Set wk = Workbooks.Open(strPath & "\" & ph)    For Each sh In wk.Worksheets      sh.UsedRange.Copy wb.Sheets(1).Range("a65536").End(xlUp).Offset(1, 0)    Next sh    wk.Close False    ph = Dir  Loop  wb.SaveAs ThisWorkbook.Path & "\合并文档.xlsx"  wb.Close  Application.DisplayAlerts = True  Application.ScreenUpdating = TrueEnd Sub