Create a new worksheet and rename tab

[united2017]

Hi All,

I am trying to create a macro where a new worksheet tab is created, and the macro to rename the tab as per Cell F4, the values in column H - 'This Period' is added to Column G - "Cumulative Previous" and then column H is blanked out.

Also with the claim number, Is there a way of automatically populating that field instead of manually typing it in?

Many Thanks,

P

 

[Alex Blakenburg]

Version 2

Sub ReplicateSheet_v02()

    Dim srcSht As Worksheet, destSht As Worksheet
    Dim strToFind As String
    Dim rngSubTot1 As Range, rngSubTot2 As Range
    Dim rngSect1 As Range, rngSect2 As Range, rCell As Range
    
    Set srcSht = Worksheets(1)
    strToFind = "SubTotal"
    
    srcSht.Copy before:=Worksheets(1)
    Set destSht = ActiveSheet
    
    With destSht
        .Unprotect
        .Range("F4").Value = .Range("F4").Value + 1
        .Name = .Range("F4")
    End With
    
    With destSht.Columns("C")
        Set rngSubTot1 = .Find(What:=strToFind, after:=.Cells(1, 1), _
                        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set rngSubTot2 = .FindNext(after:=rngSubTot1)
    End With
    
    With destSht
        Set rngSect1 = .Range(.Cells(10, "G"), .Cells(rngSubTot1.Row - 1, "G"))
        Set rngSect2 = .Range(.Cells(rngSubTot1.Row + 2, "G"), .Cells(rngSubTot2.Row - 1, "G"))
        
        rngSect1.Value = rngSect1.Offset(, 2).Value
        rngSect2.Value = rngSect2.Offset(, 2).Value
        rngSect1.Offset(, 1).ClearContents
        rngSect2.Offset(, 1).ClearContents
    End With
    
    destSht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                    False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
                    AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub

 

[united2017]

Version 2

Sub ReplicateSheet_v02()

    Dim srcSht As Worksheet, destSht As Worksheet
    Dim strToFind As String
    Dim rngSubTot1 As Range, rngSubTot2 As Range
    Dim rngSect1 As Range, rngSect2 As Range, rCell As Range
   
    Set srcSht = Worksheets(1)
    strToFind = "SubTotal"
   
    srcSht.Copy before:=Worksheets(1)
    Set destSht = ActiveSheet
   
    With destSht
        .Unprotect
        .Range("F4").Value = .Range("F4").Value + 1
        .Name = .Range("F4")
    End With
   
    With destSht.Columns("C")
        Set rngSubTot1 = .Find(What:=strToFind, after:=.Cells(1, 1), _
                        LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
        Set rngSubTot2 = .FindNext(after:=rngSubTot1)
    End With
   
    With destSht
        Set rngSect1 = .Range(.Cells(10, "G"), .Cells(rngSubTot1.Row - 1, "G"))
        Set rngSect2 = .Range(.Cells(rngSubTot1.Row + 2, "G"), .Cells(rngSubTot2.Row - 1, "G"))
       
        rngSect1.Value = rngSect1.Offset(, 2).Value
        rngSect2.Value = rngSect2.Offset(, 2).Value
        rngSect1.Offset(, 1).ClearContents
        rngSect2.Offset(, 1).ClearContents
    End With
   
    destSht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                    False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
                    AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub

Brilliant, you legend! thank you!

 

[Alex Blakenburg]

You're welcome. Glad we could help.

 

[Peter_SSs]

Brilliant, you legend! thank you!

The marked solution has been changed accordingly. In your future questions, please mark the post as the solution that actually answered your question, instead of your feedback message as it will help future readers. No further action is required for this thread.

Two other things:

1. I suggest that you update your Account details (click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)
   
   
2. When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you in post #5. Compare the look and readability of that code to your code in post #3.