合并当前工作簿下的所有工作表

Option Explicit

Sub hbgzb()

Dim sh As Worksheet, flag As Boolean
Dim i As Single, hrow As Single, hrowc As Single

flag = False

For i = 1 To Sheets.Count
If Sheets(i).Name = "AllSheets" Then flag = True
Next

If flag = False Then
Set sh = Worksheets.Add
sh.Name = "AllSheets"
Sheets("AllSheets").Move after:=Sheets(Sheets.Count)
End If

For i = 1 To Sheets.Count
If Sheets(i).Name <> "AllSheets" Then
hrow = Sheets("AllSheets").UsedRange.Row
hrowc = Sheets("AllSheets").UsedRange.Rows.Count

If hrowc = 1 Then
Sheets(i).UsedRange.Copy Sheets("AllSheets").Cells(hrow, 1).End(xlUp)
Else
Sheets(i).UsedRange.Copy Sheets("AllSheets").Cells(hrow + hrowc - 1, 1).Offset(1, 0)
End If

End If
Next i

MsgBox ("Complted ... OK ")

End Sub

中文版支持的 ....

Option Explicit

Sub hbgzb()

Dim sh As Worksheet, flag As Boolean
Dim i As Single, hrow As Single, hrowc As Single

flag = False

For i = 1 To Sheets.Count
If Sheets(i).Name = "合并数据" Then flag = True
Next

If flag = False Then
Set sh = Worksheets.Add
sh.Name = "合并数据"
Sheets("合并数据").Move after:=Sheets(Sheets.Count)
End If

For i = 1 To Sheets.Count
If Sheets(i).Name <> "合并数据" Then
hrow = Sheets("合并数据").UsedRange.Row
hrowc = Sheets("合并数据").UsedRange.Rows.Count

If hrowc = 1 Then
Sheets(i).UsedRange.Copy Sheets("合并数据").Cells(hrow, 1).End(xlUp)
Else
Sheets(i).UsedRange.Copy Sheets("合并数据").Cells(hrow + hrowc - 1, 1).Offset(1, 0)
End If

End If
Next i

MsgBox ("任务已完成")

End Sub