Create a new tab, next number

[cartmanbrra]

I do standard monthly invoicing, and want to automate having to create a new tab and move a set of percentages from column I to F.

Id like to copy tab called "PC 01" and create a new tab called "PC 02" as an exact duplicate of the tab. Then I want to move the percentages in I31:I43 and I48:I50 to the same rows in column F.

Thank you

 

[Dim Me as xlNoob]

Oh excellent, nice find. Ok well here you go:

Sub NewMonth()
    Dim sh As Worksheet, newSh As Worksheet, intPC As Variant
    Dim arrSh() As Integer, suffix As String, cell As Range
    
    ReDim arrSh(1 To Worksheets.Count)
    For Each sh In Worksheets
        If sh.Name Like "PC*" Then
            intPC = intPC + 1
            suffix = Right(sh.Name, 1)
            If Not IsNumeric(suffix) Then
                arrSh(intPC) = Mid(sh.Name, 4, Len(sh.Name) - 4)
                suffix = Right(sh.Name, 1)
            Else
                arrSh(intPC) = Right(sh.Name, Len(sh.Name) - 3)
                suffix = ""
            End If
        End If
    Next sh
    
    intPC = WorksheetFunction.Max(arrSh)
    intPC = Format(intPC, "#00")
    
    Worksheets("PC " & intPC & suffix).Copy after:=Worksheets("PC " & intPC & suffix)
    Set newSh = Worksheets("PC " & intPC & suffix & " (2)")
    With newSh
        .Name = "PC " & Format(intPC + 1, "#00")
        .Range("I31:I43").Cut Range("F31")
        .Range("I48:I50").Cut Range("F48")
    End With
End Sub

So this code will allow you to use any alphabetical suffix (1 character long only) and when it copies the new sheet it drops it off. Also if you have say a set of PC 03 sheets like PC 03, PC 03R, PC 03T etc... the sheet copied by the code will be the last sheet in the tabs and the name will be PC 04. Is there any changes you would like?

 

[cartmanbrra]

This is perfect for copying the new sheet but my data isnt going to the right place. I'd like it to go into column F on the newly created sheet rather than the old one being copied.

 

[Dim Me as xlNoob]

Oh shoot sorry! I missed a "." on two lines:

        .Range("I31:I43").Cut .Range("F31")
        .Range("I48:I50").Cut .Range("F48")

 

[cartmanbrra]

excellent, one more add on. is there away to have the date in cell F10 updated in the new tab to todays date?

 

[Dim Me as xlNoob]

No worries. Just to be clear you want F10 in the new sheet to display the current date when the new sheet was created? Instead of constantly updating to the current date using the TODAY() function?

This should do the trick:

Sub NewMonth()
    Dim sh As Worksheet, newSh As Worksheet, intPC As Variant
    Dim arrSh() As Integer, suffix As String, cell As Range
    
    ReDim arrSh(1 To Worksheets.Count)
    For Each sh In Worksheets
        If sh.Name Like "PC*" Then
            intPC = intPC + 1
            suffix = Right(sh.Name, 1)
            If Not IsNumeric(suffix) Then
                arrSh(intPC) = Mid(sh.Name, 4, Len(sh.Name) - 4)
                suffix = Right(sh.Name, 1)
            Else
                arrSh(intPC) = Right(sh.Name, Len(sh.Name) - 3)
                suffix = ""
            End If
        End If
    Next sh
    
    intPC = WorksheetFunction.Max(arrSh)
    intPC = Format(intPC, "#00")
    
    Worksheets("PC " & intPC & suffix).Copy after:=Worksheets("PC " & intPC & suffix)
    Set newSh = Worksheets("PC " & intPC & suffix & " (2)")
    With newSh
        .Name = "PC " & Format(intPC + 1, "#00")
        .Range("I31:I43").Cut .Range("F31")
        .Range("I48:I50").Cut .Range("F48")
        dForm = Worksheets("PC " & intPC & suffix).Range("F10").NumberFormat
        .Range("F10").Value = Format(Now, dForm)
    End With
End Sub