Hallo zusammen,

ich habe folgendes Makro aufgezeichnet, möchte es aber nicht nur auf diese Datei anwenden sondern jede Woche auf eine aktuelle mit anderen Werten.

Könnt ihr mal drüberschauen und es vereinfachen?

Erklärungen sind im Makro drin.

Sub Differenzprotokollbearbeiten()
'
' Differenzprotokollbearbeiten Makro
'

' 1. Zeile 1 mit Filter versehen
' 2. Alle Zeilen entfernen, wenn in Spalte AF eine 1 drinsteht
    ActiveSheet.Range("$A$1:$AF$124078").AutoFilter Field:=30, Criteria1:="1"
    Rows("78:78").Select
    Range("E78").Activate
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$AF$122264").AutoFilter Field:=30
' 3. Spalte A markieren und eine Spalte hinzufügen und mit Überschrift Kennzahl versehen
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "Kennzahl"
' 4. Pivottabelle erstellen ("Zellenbeschriftungen = Filiale / Summe von VK diff ges.")
    Cells.Select
    Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Daten1!R1C1:R1048576C33", Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Tabelle1!R3C1", TableName:="PivotTable1", _
        DefaultVersion:=xlPivotTableVersion14
    Sheets("Tabelle1").Select
    Cells(3, 1).Select
    Range("B9").Select
    With ActiveSheet.PivotTables("PivotTable1")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Filiale")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("VK diff ges.")
        .Orientation = xlRowField
        .Position = 2
    End With
    Range("A7").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Filiale").Subtotals = Array _
        (False, False, False, False, False, False, False, False, False, False, False, False)
    Range("B9").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("VK diff ges.").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    Range("B10").Select
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("VK diff ges."), "Anzahl von VK diff ges.", xlCount
    Range("B6").Select
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Anzahl von VK diff ges."). _
        Function = xlSum
    Range("B7").Select
' 5. Aufsteigend sortieren in Spalte "Summe von VK diff ges."
    ActiveSheet.PivotTables("PivotTable1").PivotFields("Filiale").AutoSort _
        xlAscending, "Summe von VK diff ges.", ActiveSheet.PivotTables("PivotTable1"). _
        PivotColumnAxis.PivotLines(1), 1
' 6. In Spalte C zu jeder Filiale eine Kennzahl hinzufügen.
    Range("C5").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("C6").Select
    ActiveCell.FormulaR1C1 = "2"
    Range("C7").Select
    ActiveCell.FormulaR1C1 = "3"
    Range("C5:C7").Select
    Selection.AutoFill Destination:=Range("C5:C1987")
    Range("C5:C1987").Select
    Range("D8").Select
' 7. Per Sverweis im Tabellenblatt "Daten1" die Kennzahlen der Filialen zuordnen
    Sheets("Daten1").Select
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[5],Tabelle1!C:C[2],3,FALSE)"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A122264")
    Range("A2:A122264").Select
    Rows("1:1").Select
' 8. Aufsteigend sortieren in Spalte A ("Kennzahl")
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveWorkbook.Worksheets("Daten1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Daten1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Daten1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
' 9. Formeln durch Werte ersetzen
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' 10.  Teilergebnisse in Spalten N (14) (VK diff ges.) und Z (26) (Diff nach Verbuchung) einfügen. Gruppieren nach: "Filiale" / Unter Verwendung von: "Summe"
    Cells.Select
    Application.CutCopyMode = False
    Selection.Subtotal GroupBy:=6, Function:=xlSum, TotalList:=Array(14, 26), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
' 11. Gruppierungen entfernen
    Selection.ClearOutline
    Range("J9").Select
    ActiveWindow.SmallScroll Down:=-24
' 12. Spalte G markieren und eine Spalte einfügen.
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight
' 13. Mit der Formel Links nur die 8 Stelligen Filialnummern anzeigen lassen. Dann werden die Filialnummern kopiert und als Werte in Spalte F (6) eingefügt.
'     Dies soll dazu dienen, das Wort "Ergebnis" in den Ergebniszeilen (Teilergebnis) zu entfernen.
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=+LEFT(RC[-1],8)"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G124244")
    Range("G2:G124244").Select
    Selection.Copy
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' 14. Spalte G wieder entfernen
    Columns("G:G").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft
' 15. Nach Ergebniszeilen Filtern (in Spalte D (4) nach Leere Filtern)
    Range("F3").Select
    ActiveSheet.Range("$A$1:$AG$124244").AutoFilter Field:=4, Criteria1:="="
' 16. Per Sverweis die Kennzahlen den Filialen in den Ergebniszeilen zuordnen.
    Range("A78").Select
    ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[5],Tabelle1!C:C[2],3,FALSE)"
    Range("A78").Select
    Selection.Copy
    Range("A115:A124245").Select
    ActiveSheet.Paste
    Range("F1951").Select
    Range(Selection, Selection.End(xlDown)).Select
' 17. In der letzten Ergebniszeile stand noch das Wort Ergebnis nach der Filialnummer.Ich versteh zwar nicht warum aber das muss entfernt werden.
'     Damit der Sverweis greift musste die Zelle als Text formatiert werden.
    Range("F124245").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "31309095"
    Range("F124245").Select
    Selection.NumberFormat = "@"
    ActiveCell.FormulaR1C1 = "31309095"
    Range("N124245").Select
    ActiveWindow.SmallScroll Down:=-18
    Range("F121370").Select
    Range(Selection, Selection.End(xlUp)).Select
' 18. Alle Ergebniszeilen bis Spalte AE (31) in "Knallrot" / Schriftfarbe "Weiss" und "Fett" formatiert.
    Range("D230").Select
    ActiveWindow.SmallScroll Down:=-33
    Range("A59:AE32831").Select
    ActiveWindow.SmallScroll Down:=-87
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWindow.SmallScroll Down:=24
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = -0.249977111117893
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    ActiveWindow.SmallScroll Down:=-18
    Selection.Font.Bold = True
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    ActiveSheet.Range("$A$1:$AG$124244").AutoFilter Field:=4
    Range("L10").Select
    ActiveWindow.SmallScroll Down:=-39
' 19. Spalten N/V/Z als Währung formatieren
    Range("N:N,V:V,Z:Z").Select
    Range("Z1").Activate
    Selection.NumberFormat = "#,##0.00 $"
    Range("S10").Select
' 20. Unnötige Spalten entfernen
    Columns("AB:AG").Select
    Selection.Delete Shift:=xlToLeft
    Range("AA1").Select
End Sub

Vielen Dank im Voraus

Grüße Emre