Sub 合併工作表()
Dim mySht As Worksheet
Dim myRng1 As Range
Dim myRng2 As Range
Dim i
Set mySht = Worksheets.Add(After:=Sheets(Sheets.Count))
With mySht
.Name = "new" '設定表名
End With
Worksheets("new").Move Before:=Worksheets(1)
Set mySht = Worksheets(1)
For i = 2 To 4 Step 1
Worksheets(i).Select
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Application.CutCopyMode = False
Selection.Copy
mySht.Select
ActiveSheet.Paste
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Next
Worksheets(2).Select '加入標題
Rows("1:1").Select
Selection.Copy
mySht.Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("a1").Select
End Sub