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

 

[united2017]

I have somewhat managed to Record the Macro - but when it goes to creating the 3rd claim, it takes the values from the initial worksheet as opposed to the previous one. Still cant get the auto numbering and naming of the sheet.

 

[united2017]

Hi All,

My code is as per below - Again - I am no good at VBA - Just want to make life easier for the team.

It keeps looking at the Initial Sheet when I go to the 3rd claim.

Sub NewClaim()
'
' NewClaim Macro
' New Claim
'

'
Dim sheetName As String
sheetName = InputBox("Enter the name of the new sheet:")

If sheetName = "" Then Exit Sub

Dim newSheet As Worksheet
Set newSheet = Sheets("1")
newSheet.Visible = True
newSheet.Copy Before:=Worksheets("1")
newSheet.Visible = True

ActiveSheet = ActiveWorksheet
Range("i10:i33").Select
Selection.Copy
Range("G10").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H10:H33").Select
Application.CutCopyMode = False
Selection.ClearContents
End Sub

 

[mmn1000]

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

Hi ,
See if the following code works for you

Sub Create()

'**********************************************
Sheets("1").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Range("F4")
'**********************************************

    Range("H10:H33").Select
    Selection.Copy
    Range("G10:G33").Select
    ActiveSheet.Paste
    Range("H10:H33").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A1").Select
End Sub

 

[united2017]

Not really working, I tried recording the Macro again to update the bottom bit.

Works for the first sheet copy - doesnt work for the consecutive sheets - also copies from Sheet 1 whreeas I want it to copy from the next sheet...

Sub Create()

Sheets("Main").Copy After:=Sheets(Sheets.Count)

    Range("I10:I33").Select
    Selection.Copy
    Range("G10").Select
    Application.CutCopyMode = False
    ActiveSheet.Unprotect
    Range("I10:I33").Select
    Selection.Copy
    Range("G10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("H10:H33").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
        AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub

 

[Alex Blakenburg]

How are you going to trigger the macro to run ?
Do you want the new sheets to go 1,2,3..... or 3,2,1 ?

 

[jolivanes]

If you would explain in detail but in a concise manner what you would like to achieve, what would that be?
Usually posting codes that do not work is not of any help

 

[united2017]

If you would explain in detail but in a concise manner what you would like to achieve, what would that be?
Usually posting codes that do not work is not of any help

Hi Jolivanes,

Basically, we have a contract which has been agreed upon with Quantities and Rates. Every month, based on how much of the original contract has been completed, we send a claim to the customer. The project could go on for months, therefore what I want is at the end of the month, once a claim has been confirmed, run a macro to create the next months sheet, and the quantities invoiced become Cumulative - Column G - and Column H becomes blank. This repeats till the project is complete.

How are you going to trigger the macro to run ?
Do you want the new sheets to go 1,2,3..... or 3,2,1 ?

3,2,1

 

[Alex Blakenburg]

On a copy of your workbook give this a try.
It assumes that the sheet you want to copy is the first sheet from the left.

Sub ReplicateSheet()

    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, "H"), .Cells(rngSubTot1.Row - 1, "H"))
        Set rngSect2 = .Range(.Cells(rngSubTot1.Row + 2, "H"), .Cells(rngSubTot2.Row - 1, "H"))
    End With
    
        For Each rCell In rngSect1
            rCell.Offset(, 1) = rCell.Offset(, 1) + rCell
            rCell = 0
            rCell.Offset(, 4) = rCell.Offset(, 4) + rCell.Offset(, 3)
            rCell.Offset(, 3) = 0
        Next rCell
        
        For Each rCell In rngSect2
            rCell.Offset(, 1) = rCell.Offset(, 1) + rCell
            rCell = 0
            rCell.Offset(, 4) = rCell.Offset(, 4) + rCell.Offset(, 3)
            rCell.Offset(, 3) = 0
        Next rCell
    
    destSht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                    False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
                    AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub

 

[united2017]

On a copy of your workbook give this a try.
It assumes that the sheet you want to copy is the first sheet from the left.

Sub ReplicateSheet()

    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, "H"), .Cells(rngSubTot1.Row - 1, "H"))
        Set rngSect2 = .Range(.Cells(rngSubTot1.Row + 2, "H"), .Cells(rngSubTot2.Row - 1, "H"))
    End With
   
        For Each rCell In rngSect1
            rCell.Offset(, 1) = rCell.Offset(, 1) + rCell
            rCell = 0
            rCell.Offset(, 4) = rCell.Offset(, 4) + rCell.Offset(, 3)
            rCell.Offset(, 3) = 0
        Next rCell
       
        For Each rCell In rngSect2
            rCell.Offset(, 1) = rCell.Offset(, 1) + rCell
            rCell = 0
            rCell.Offset(, 4) = rCell.Offset(, 4) + rCell.Offset(, 3)
            rCell.Offset(, 3) = 0
        Next rCell
   
    destSht.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
                    False, AllowFormattingCells:=True, AllowFormattingRows:=True, _
                    AllowInsertingRows:=True, AllowDeletingRows:=True
End Sub

Thanks, Almost there.

It is creating the replicate perfectly well, just want the values in Column I to be pasted as values in Column G and clear the contents in h10:h33 - Based on the above code, it is adding them - please see screen shot.