format number in VBA as 001

[gellis11239]

Hi all, i'm sure i'm missing something easy.

I have some code that copies a sheet and renames it in numerical order. (First sheet is "PON 9001") but the way this code is the current way I get PON 91, PON 92 etc. I really need PON 9001, PON 9002....... al the way to PON 9500. I just can't work it out.

Current code is

Sub Create()
    Dim I As Long
    Dim xNumber As Integer
    Dim xName As String
    Dim xActiveSheet As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
    Set xActiveSheet = ActiveSheet
    xNumber = InputBox("Enter number of times to copy the current sheet")
    For I = 1 To xNumber
        xName = ActiveSheet.Name
        xActiveSheet.Copy After:=ActiveWorkbook.Sheets(xName)
        ActiveSheet.Name = "PON 9" & I
        
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End Sub

 

[Saurabhj]

Hi,

use

ActiveSheet.Name = "PON " & 9000 + I

 

[mohadin]

Missed up

 

[RoryA]

Hi

Try

 ActiveSheet.Name = "PON 9" & "00" & I

That would give results like PON 90010 and PON 900500 rather than PON 9010 and PON 9500.

 

[mohadin]

@RoryA​

Right
Thank's

 

[dmt32]

Hi,
welcome to forum

try this update to your code & see if does what you want

Sub Create()
    Dim i               As Long
    Dim xNumber         As Variant
    Dim xName           As String, SheetName As String
    Dim xActiveSheet    As Worksheet
   
    Set xActiveSheet = ActiveSheet
   
    Do
        xNumber = InputBox("Enter number of times To copy the current sheet")
        'cancel pressed
        If StrPtr(xNumber) = 0 Then Exit Sub
    Loop Until IsNumeric(xNumber)
   
    Application.ScreenUpdating = False
    For i = 1 To xNumber
        SheetName = "PON 9" & Format(i, "000")
        'check sheet exists
        If Not Evaluate("ISREF('" & SheetName & "'!A1)") Then
            'xName = ActiveSheet.Name
            xActiveSheet.Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
            ActiveSheet.Name = SheetName
        End If
    Next
    xActiveSheet.Activate
    Application.ScreenUpdating = True
End Sub

Dave

 

[gellis11239]

Thanks guys, @dmt32 your code worked a treat. Merry Christmas to you all.