Excel 工作表合并不是一个困难的问题，但是在应用的时候可能会不知所措，因为有大量的数据表要合并到一个表里，通常会选择一个一个表复制，似乎这样做就显得十分低效，而且真得没有必要这样工作。
本示例制作了一个任意选择工作表，并工作表合并到一个表里的方法，如下图所示：
可以通过一个按钮来选择想要合并的表，然后，输入一下合并后新的工作表名，接着就等程序自动完成合并，右侧列表框中会显示出合并后的工作表名称。
可以双击打开合并后的工作表，进行查看。这都不是重点。、
流程就是这样，重点来看一下代码：
Private Sub 合并工作表()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim xExcel As String, xi As Integer, xArr
With Application.FileDialog(msoFileDialogFilePicker)
If .Show = -1 Then
.Filters.Clear
.Filters.Add "Excel文件", "*.xls;*.xlsx;*.xlsm"
.AllowMultiSelect = True
ReDim xArr(1 To .SelectedItems.Count)
For xi = 1 To UBound(xArr)
xArr(xi) = .SelectedItems(xi)
Next xi
End If
End With
Dim xE As Variant
Dim w As Workbook, wX As Workbook, wCaption As String
wCaption = VBA.InputBox("输入文件名", "保存文件", VBA.Format(VBA.Date, "yyyymmdd"))
If VBA.Len(VBA.Trim(wCaption)) = 0 Then Exit Sub
Set wX = Workbooks.Add
wX.SaveAs ThisWorkbook.Path & "" & wCaption & ".xlsx"
Me.ListBox2.AddItem wX.FullName
For Each xE In xArr
Workbooks.Open xE
Set w = ActiveWorkbook
w.Worksheets(1).Copy wX.Worksheets(1)
wX.Save
w.Close
With Me.ListBox1
.AddItem xE
End With
Next xE
wX.Save
wX.Close
Erase xArr
Set w = Nothing
Set wX = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
这样一个操作，可大大减少合并工作表操作的难度，显而易见是一个很有用的东西。
欢迎关注、收藏
---END---
