Ich habe mal ChatGPT gefragt. Das schlägt mir folgendes vor:

  Dim ws As Worksheet
  Dim lastRow As Long
  Dim rngToClear As Range
  Dim rngToColor As Range
  Dim rngFormula1 As Range
  Dim rngFormula2 As Range
  Dim rngDelete As Range

  ' Setze das aktive Tabellenblatt als das zu verarbeitende Tabellenblatt
  Set ws = ActiveSheet

  ' Kopiere Zeile 2 und füge sie ein
  ws.Rows(2).Copy
  ws.Rows(3).Insert Shift:=xlDown

  ' Lösche Zellen A2 bis Q2
  Set rngToClear = ws.Range("A2:Q2")
  rngToClear.ClearContents

  ' Setze die Füllfarbe der Zellen A2 bis Q2 auf keine Füllung
  Set rngToColor = ws.Range("A2:Q2")
  rngToColor.Interior.Color = xlNone

  ' Finde die letzte belegte Zeile in Spalte R
  lastRow = ws.Cells(ws.Rows.Count, "R").End(xlUp).Row

  ' Setze die Formel für die Summe in Spalte E unterhalb der letzten belegten Zeile in Spalte R
  Set rngFormula1 = ws.Cells(lastRow + 1, "E")
  rngFormula1.Formula = "=SUMME(R2:R" & lastRow & ")"

  ' Setze die Formel für die Summe in der Zeile unterhalb der Formel in Spalte E
  Set rngFormula2 = ws.Cells(lastRow + 2, "E")
  rngFormula2.Formula = "=SUMME(C2:C" & lastRow & ")"

  ' Setze die Zelle B2 als aktive Zelle
  ws.Range("B2").Select

Das Script läuft allerdings beim zweiten Aufruf in Laufzeitfehler 1004, weil durch ws.Rows(ws.Rows.Count).Insert Shift:=xlDown dafür gesorgt wird, dass etwas über das Ende des Tabellenblatts hinaus eingeschoben werden würde. Dabei hatte ich genau dies nach dem ersten Fehler der Art schon als Anforderung mitübergeben. Ich hab dann gebeten, 14 Zeilen tiefer die komplette Zeile zu löschen, um Platz  zu schaffen ...
 

  ' Lösche die 14. Zeile unterhalb der letzten belegten Zeile in Spalte R
  Set rngDelete = ws.Rows(lastRow + 14)
  rngDelete.Delete Shift:=xlUp

Das hab ich vor dem Fokus auf Zelle B2 eingefügt. Der Fehler tritt weiter auf.