自動重命名多個工作表並將主要內容複製到所有新創建的工作表

Question

我有一個包含格式化列的工作表（B2：Y14和A18：B24），並且試圖創建與即將到來的月份中一樣多的工作表然後將主圖紙數據複製到每個新創建的圖紙中。

例如：對於12月份，我需要創建31張名爲DEC1 ... DEC31的紙張，其中包含來自主紙張的數據。

我已經試過如下：

Sub AddSheets() 
    Dim j As Integer 
    Dim curSheet As String 
    Dim prevSheet As String 

    'Dim summarySheet As Workbook 

    newName = Application.InputBox("Name", "Rename Sheet", "", Type:=2) 
    numSheets = Application.InputBox("Range", "Number of Sheets", "", Type:=1) 

    prevSheet = "Main" 
    'Set summarySheet = Sheets("Main").UsedRange.Copy 


    For j = 1 To numSheets 
     Sheets.Add After:=Sheets(CStr(prevSheet)) 
     curSheet = newName & " " & j 
     Sheets(CStr(curSheet)).Name = curSheet 
     Sheets("Main").UsedRange.Copy 
     Sheets(CStr(curSheet)).Select 
     Sheets(CStr(curSheet)).Paste 
     prevSheet = curSheet 
     'ActiveSheet.Paste 
    Next j 
End Sub 

Answer 1

最簡單的方法是添加時設定新的工作表的變量。然後你可以參考它。

Sub AddSheets() 
    Dim j As Integer 
    Dim prevSheet As String 
    Dim newsht As Worksheet 
    'Dim summarySheet As Workbook 

    newName = Application.InputBox("Name", "Rename Sheet", "", Type:=2) 
    numSheets = Application.InputBox("Range", "Number of Sheets", "", Type:=1) 

    prevSheet = "Main" 
    'Set summarySheet = Sheets("Main").UsedRange.Copy 


    For j = 1 To numSheets 
     Set newsht = Sheets.Add(After:=Sheets(CStr(prevSheet))) 
     newsht.Name = newName & " " & j 
     Sheets("Main").UsedRange.Copy newsht.Range("A1") 
     prevSheet = newsht.Name 

    Next j 
End Sub