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.
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
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
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
