複製 - 中華工程

Sub 新工作表()
'
' 新工作表 Macro
' gmadmin 在 2010/6/11 錄製的巨集
'

Sheets(1).Select
Sheets.Add
End Sub
Sub 複製()

Dim i, j As Integer

j = InputBox("請輸入工作表張數")


For i = 2 To j + 1



Sheets(i).Select


If i = 2 Then
Range("A1").Select
Else
Range("A2").Select
End If

Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Sheets(1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

Next




End Sub


Public Sub 整合()
新工作表
複製
Range("A1").Select
End Sub