Excel VBA para adicionar total cumulativo a nova planilha

Question

Estou tentando criar uma pasta de trabalho que crie uma nova página e coloque o total acumulado de duas células para adicionar aos novos totais inseridos na nova página. Consegui criar uma nova página, mas não consigo descobrir o código para transferir o total acumulado para a próxima página. O total em cada página é em J22, total acumulado para esse total em K22 e o outro total é em J32, total acumulado em K32.

Aqui está o código que tenho para a primeira parte (Adicionar novo dia):

Function NewShtName(NewDate As Date) As String
Dim Mon As String

Select Case Month(NewDate)
Case 1: Mon = "Jan"
Case 2: Mon = "Feb"
Case 3: Mon = "Mar"
Case 4: Mon = "Apr"
Case 5: Mon = "May"
Case 6: Mon = "Jun"
Case 7: Mon = "Jul"
Case 8: Mon = "Aug"
Case 9: Mon = "Sep"
Case 10: Mon = "Oct"
Case 11: Mon = "Nov"
Case 12: Mon = "Dec"
End Select

NewShtName = Mon & Day(NewDate)
End Function

Sub Create_New_Day()
'This adds a new day to the Daily Report
Dim NewDay As Integer
Dim Sht2Name As String
Dim NewName As String
Dim ThisDate As Date
Dim Temp As String
Dim DailyID As Integer


ThisDate = ActiveSheet.Range("J2")
DailyID = ActiveSheet.Range("K47")

If ActiveSheet.Range("J2") = "" Then
Ans2 = MsgBox("There is no date on the Report" & Chr(13) _
       & "Report for sheet " & ActiveSheet.Name & ".", vbInformation, "Company Name")
Exit Sub
End If

NewName = NewShtName(ThisDate + 1)

For Sht = 2 To Sheets.Count
If Sheets(Sht).Name = NewName Then
    Ans1 = MsgBox("A sheet with the name " & NewName & " already exists." & Chr(13) _
        & Chr(13) & "Check to make sure that the sheet names" & Chr(13) _
        & "correspond to the dates on the dailies.", vbExclamation, "Company Name")
    Exit Sub
End If

If Sheets(Sht).Range("J2") = ThisDate + 1 Then
    Ans1 = MsgBox("Sheet " & Sheets(Sht).Name & " already has the date " & ThisDate + 1 & " on it." & Chr(13) _
    & Chr(13) & "A new day will not be added.", vbExclamation, "Company Name")
    Exit Sub
End If
Next Sht


ActiveSheet.Copy After:=ActiveSheet

NewDay = Sheets.Count

Sheets(NewDay).Range("J2") = ThisDate + 1
Sheets(NewDay).Name = NewName

Sht2Name = Sheets(2).Name

Sheets(NewDay).Range("K47") = DailyID + 1


With Sheets(NewDay)    'clears previous days comments

Range("C6:K11").Select
Selection.ClearContents
Range("C14:K19").Select
Selection.ClearContents
Range("C24:K29").Select
Selection.ClearContents
Range("C33:K38").Select
Selection.ClearContents
Range("C41:K46").Select
Selection.ClearContents
Range("D22:H22").Select
Selection.ClearContents
Range("G32:H32").Select
Selection.ClearContents

End With

End Sub

    

Answer 1

Idéia, uma dica para você, NOTE CÓDIGO NÃO-ATUALIZADO.

NewDay = Sheets.Count
cmlSum=0
for sht=0 to NewDay
  cmlSum=Sheets(sht).Range("J22")+cmlSum
  Sheets(sht).Range("K22")=cmlSum
next

... e você precisa corrigir quaisquer falhas, como %código% pelo menos não é o que você pretende que seja.