Home » excel » vba – How to create new worksheets with similar names, like "Period1", "Period", etc

vba – How to create new worksheets with similar names, like "Period1", "Period", etc

Posted by: admin May 14, 2020 Leave a comment

Questions:

if i use this kind of code:

Sub CreateSheet()

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

it creates one sheet with name “Period”. I want to create macro, that creates worksheet named “Period 1” when I run it first time. On the second time it would create “Period 2”, etc. So only one sheet / run.

How do I do that? Thanks for your help in advance.

How to&Answers:

Try this

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

Answer:

Based on the additional information a first shot could be

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:

This will do exactly what you asked. Will Create Sheet Period and if it already exists it will loop until it finds the next available number and create the next Sheet. As an example I have added that it will copy the Range A2:H20 from the Sheet that was active when you ran the macro and paste it on the newly created sheet.

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 Function taken from here: Excel VBA If WorkSheet("wsName") Exists