Автоматическое переименование нескольких листов и копирование содержимого основных для всех вновь созданных листов

Question

У меня есть листок, содержащий форматированные столбцы (B2: Y14 и A18: B24), и я пытаюсь создать столько листов, сколько есть в следующем месяце а затем скопировать данные основного листа в каждый из вновь созданных листов.

Например: за декабрь месяца мне нужно было бы создать 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