Dear all,

I am working on a VBA code and I came until this point that I want to multiple a sheet and give it a new name (a number). That is done . But after that another piece of the code needs to perform this on EACH worksheet, this is the part that is not working.

Sub Newworksheet()
    Dim I As Integer, w As Worksheet
    Dim x As Integer
    
    Application.ScreenUpdating = False
    x = InputBox("Enter number of new purchase categories")
    For numtimes = 1 To x
    Sheets("1").copy Before:=Sheets("output")
    Set w = ActiveSheet 'the copy
    On Error Resume Next
    I = 1
    Do
        Worksheets(I).Activate
        If Err.Number <> 0 Then 'sheet name doesn't exist yet
            w.Name = I - 6
            Exit Do
        End If
        I = I + 1
    Loop
    On Error GoTo 0
    w.Activate
    Next
    
    For Each w In ActiveWorkbook.Worksheets
        Range("B237").Select
        Selection.copy
        Range("B235").Select
        Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
        Range("B235").Value = Val(Range("B235").Value)
    Next w
    Application.ScreenUpdating = True
End Sub
Can you please help me.

Best,

Jeroen