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
 













 
 博文
博文
 
 
 
 
 
 

 








 13130
13130