Как создавать новые рабочие листы с похожими именами, такими как «Period1», «Period» и т. Д.

Question

если я использую такой код:

Sub CreateSheet()

    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = "Period"
    End With End Sub

создает один лист с именем «Период». Я хочу создать макрос, который создает лист с именем «Период 1» при первом запуске. Во второй раз это создаст «Период 2» и т. Д. Так что только один лист / прогон.

Как мне это сделать? Заранее спасибо за помощь.

Answer 1

На основании дополнительной информации первый выстрел может быть

Option Explicit

Sub Create()
Dim ws As Worksheet
Dim i As Long

    i = GetNr(ThisWorkbook, "Period*")


    With ThisWorkbook
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = "Period " & CStr(i + 1)
    End With

End Sub

Function GetNr(wb As Workbook, shtPattern As String) As Long
Dim maxNr As Long
Dim tempNr As Long

Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If ws.Name Like shtPattern Then
            tempNr = onlyDigits(ws.Name)
            If tempNr > maxNr Then
                maxNr = tempNr
            End If
        End If
    Next ws
    GetNr = maxNr
End Function
Function onlyDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = Len(s) To 1 Step -1
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = Mid(s, i, 1) + retval
        Else
            Exit For
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function

Answer 2

Это будет делать именно то, что вы просили. Создает период листа, и если он уже существует, он будет зацикливаться, пока не найдет следующий доступный номер и не создаст следующий лист. В качестве примера я добавил, что он скопирует диапазон A2: H20 с листа, который был активен при запуске макроса, и вставил его на вновь созданный лист.

Sub CopyToNewSheet()
    Dim ws As Worksheet
    Dim i As Long
    Dim SheetName As String, active as String
    active = ActiveSheet.Name
    SheetName = "Period"
    Do While SheetExists(SheetName) = True
        i = i + 1
        SheetName = "Period " & i
    Loop
    With ThisWorkbook
        Set ws = .Worksheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = SheetName
        .Sheets(active).Range("A2:H20").Copy
        .Sheets(SheetName).Range("A2").PasteSpecial
        'I could've used ws.Range("A2").PasteSpecial instead but I wanted the copy and paste to look similar.
    End With
End Sub
Function SheetExists(SheetName As String, Optional wb As Excel.Workbook)
   Dim s As Excel.Worksheet
   If wb Is Nothing Then Set wb = ThisWorkbook
   On Error Resume Next
   Set s = wb.Sheets(SheetName)
   On Error GoTo 0
   SheetExists = Not s Is Nothing
End Function

Функция SheetExists взята отсюда: Excel VBA, если существует рабочий лист ("wsName")

Answer 3

Попробуйте это

Sub Create()
Const LIMIT = 9
Dim ws As Worksheet
Dim i As Long

    With ThisWorkbook
        For i = 1 To LIMIT
            Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
            ws.Name = "Period " & CStr(i)
        Next i
    End With

End Sub