Kopiere data fra flere Excel ark til en ny Excel fil vha. makro

Hej

Jeg har en excel-fil for hver afdeling med faneark for hver ugentlig status samt et 'historisk status' faneark hvor jeg kan følge udviklingen i afdelingen over tid (data fra 'ugentlig status' fanearkene). I hver excel-fil er der et 'indtastnings'ark, hvor jeg klikker 'Update' - og dermed oprettes et nyt faneark med ugentlig status og data kopieres til 'his.status' arket. Nederst er koden for denne makro kopieret.

Jeg har således en excel-fil for hver afdeling med en tabel på 'his.status' arbejdet. Jeg vil gerne have disse tabeller opsummeret i en 'total' i en ny excel-fil: "Total_UgentligStatus".
Hvad skal jeg skrive ind i nedenstående kode således at hver gang jeg klikker 'Update' så lægges tallene fra den ugentlige status til summen i excel-filen "Total_UgentligStatus" ?

Makroen i 'Ugentlig status' filerne for hver afdeling:

Dim indtastArk
Dim arkDato
Public Sub Opdater()
    arkDato = Cells(1, 1)
   
    OpretDatoArk
'    nulStilIndtastning
    overførTilStatus
End Sub
Private Sub OpretDatoArk()
    Sheets("Indtastning").Activate
    With ActiveSheet
        .Cells.Select
        Selection.Copy
    End With
   
    ActiveWorkbook.Sheets.Add Before:=Sheets(4)
    Sheets(4).Name = arkDato
   
    Sheets(4).Activate
    ActiveSheet.Cells(1, 1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
     
    Application.CutCopyMode = False
   
Rem ændring af farve for indtastningsfelter
    For Each cc In ActiveSheet.Range("A3:G26").Cells
        If cc.Interior.ColorIndex = 6 Then
            cc.Interior.ColorIndex = 20
        End If
    Next cc
   
    ActiveSheet.Cells(1, 1).Select
End Sub
Private Sub nulStilIndtastning()
    Set indtastArk = ActiveWorkbook.Sheets("Indtastning")
   
    For Each cc In indtastArk.Range("A3:G29").Cells
        If cc.Interior.ColorIndex = 6 Then
            cc.ClearContents
        End If
    Next cc
End Sub
Private Sub CommandButton1_Click()
    Opdater
End Sub
Private Sub overførTilStatus()
Dim næsteRæk, statusArk, aktuelleArk
    Set statusArk = ThisWorkbook.Sheets(2)
    Set aktuelleArk = ThisWorkbook.Sheets(4)
   
Rem Find første ledige række
    With statusArk
        For ræk = 3 To 65000
            If .Cells(ræk, 1) = "" Then
                næsteRæk = ræk
                Exit For
            End If
        Next ræk
       
        .Cells(næsteRæk, 1) = arkDato                      'A - kol
        .Cells(næsteRæk, 2) = aktuelleArk.Range("E4")      'B
        .Cells(næsteRæk, 3) = aktuelleArk.Range("B4")      'C
        .Cells(næsteRæk, 4) = aktuelleArk.Range("D3")      'D
        .Cells(næsteRæk, 5) = aktuelleArk.Range("D4")      'E
        .Cells(næsteRæk, 6) = aktuelleArk.Range("B12")      'F
        .Cells(næsteRæk, 7) = aktuelleArk.Range("B15")      'G
        .Cells(næsteRæk, 8) = "'" & (aktuelleArk.Range("C18") & _
            "/" & aktuelleArk.Range("D18"))                'H
        .Cells(næsteRæk, 9) = aktuelleArk.Range("B21")      'I
        .Cells(næsteRæk, 10) = "'" & (aktuelleArk.Range("D21") & _
            "/" & aktuelleArk.Range("E21"))                'J
        .Cells(næsteRæk, 11) = aktuelleArk.Range("B24")    'K
        .Cells(næsteRæk, 12) = "'" & (aktuelleArk.Range("B27") & _
            "/" & aktuelleArk.Range("C27"))                'L
        .Cells(næsteRæk, 13) = aktuelleArk.Range("E1")      'M
        .Cells(næsteRæk, 14) = aktuelleArk.Range("F3")      'N
    End With
End Sub


Håber I kan hjælpe, jeg sætter pris på enhver hjælp jeg kan få