将不同的 Excle 合并成一个 Excle 不同 sheet 页
Sub Workbook_merge()
Rem This script is used to collect worksheets of serval workbooks into one workbook!
Dim FileOpen
Dim X As Integer
Dim Wb As Workbook
Dim sh As Worksheet
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbook(*.xlsx),*.xlsx", MultiSelect:=True, Title:="Please select the Workbooks you want to merge:")
X = 1
Application.DisplayAlerts = False
While X <= UBound(FileOpen)
Set Wb = GetObject(FileOpen(X))
For Each sh In Wb.Sheets
If Application.WorksheetFunction.CountA(sh.Cells) <> 0 Then
sh.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next
Wb.Close SaveChanges:=False
X = X + 1
Wend
Application.DisplayAlerts = False
ThisWorkbook.Save
Application.ScreenUpdating = True
End Sub
将不同 sheet 页合并为同一个 sheet
Sub Sheet_merge()
Rem This Script can be used to merge all worksheets into current worksheet!
Application.ScreenUpdating = False
For j = 1 To Sheets.Count
If Sheets(j).Name <> ActiveSheet.Name Then
X = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
Sheets(j).UsedRange.Copy ActiveSheet.Cells(X, 1)
End If
Next
Application.ScreenUpdating = True
MsgBox "All sheets have been merged!", vbInformation, "Attention"
End Sub
使用方法
选择 sheet 页,右键查看代码,复制粘贴,然后选择视图,点击宏、查看宏、执行。OK!