Hallo Ulrich,

kann ich alle Selects weglassen?

Vllt hast du Zeit und Lust mal über das Makro zu schauen und mir zu sagen was ich noch weglassen kann (Selects).

Sub Differenzprotokollbearbeiten()

Dim letzteZeile As Long

    letzteZeile = Cells(Rows.Count, 2).End(xlUp).Row
'
' Differenzprotokollbearbeiten Makro
'

' 1. Zeile 1 mit Filter versehen
' 2. Alle Zeilen entfernen, wenn in Spalte AF eine 1 drinsteht
Application.ScreenUpdating = False
    Application.DisplayAlerts = False
With ActiveSheet
.Range("A1").AutoFilter Field:=30, Criteria1:="1"
.Rows(1).Hidden = True
.UsedRange.SpecialCells(xlCellTypeVisible).Delete
.Rows(1).Hidden = False
.AutoFilterMode = False
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True

' 3. Spalte A markieren und eine Spalte hinzufügen und mit Überschrift Kennzahl versehen
Columns("A:A").Insert Shift:=xlToRight
    Range("A1") = "Kennzahl"

' 4. Pivottabelle erstellen ("Zellenbeschriftungen = Filiale / Summe von VK diff ges.")
        Cells.Select
        Sheets.Add
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Daten1!A1:AE" & letzteZeile, Version:=xlPivotTableVersion14).CreatePivotTable _
        TableDestination:="Tabelle1!R3C1", TableName:="PivotTable", _
        DefaultVersion:=xlPivotTableVersion14
    Sheets("Tabelle1").Select
    With ActiveSheet.PivotTables("PivotTable").PivotFields("Filiale")
        .Orientation = xlRowField
        .Position = 1
    End With
    ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
        "PivotTable").PivotFields("VK diff ges."), "Summe von VK diff ges.", xlSum
    ActiveCell.Columns("A:B").EntireColumn.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Rows("1:2").EntireRow.Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
    ActiveCell.Rows("1:1").EntireRow.Select
' 5. Aufsteigend sortieren in Spalte "Summe von VK diff ges."
    Selection.AutoFilter
    ActiveCell.Offset(4, 1).Range("A1").Select
    ActiveWorkbook.Worksheets("Tabelle1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").AutoFilter.Sort.SortFields.Add Key:= _
        ActiveCell.Offset(-1, 0).Range("A1"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
Worksheets("Tabelle1").Rows(2).Delete

' 6. In Spalte C zu jeder Filiale eine Kennzahl hinzufügen.
Dim Ende As Long

With ActiveSheet
  
  .Range("C2") = "1"
  .Range("C3") = "2"
   
  Ende = Cells(Rows.Count, 2).End(xlUp).Row
  
  .Range("C2:C3").AutoFill Destination:=Range("C2:C" & Ende), Type:=xlFillDefault
  
End With
      Sheets("Daten1").Select
Dim z As Long
Dim lz As Long
Dim s As Integer
  
lz = Cells(Rows.Count, 2).End(xlUp).Row
If Cells(Rows.Count, 2) <> "" Then lz = Rows.Count
 
On Error Resume Next
For z = 2 To lz
For s = 3 To 3
        Cells(z, 1).Value = WorksheetFunction.VLookup(Cells(z, 6).Value, Range("Tabelle1!A:C"), s, False)
        If Err.Number > 0 Then
            Cells(z, 1).Value = 0
            Err.Clear
        End If
    Next s
Next z

' 8. Aufsteigend sortieren in Spalte A ("Kennzahl")
    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
' 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
' 12. Spalte G markieren und eine Spalte einfügen.
    Columns("G:G").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").AutoFill Destination:=Range("G2:G" & letzteZeile)
    Range("G2:G" & letzteZeile).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)
' 16. Per Sverweis die Kennzahlen den Filialen in den Ergebniszeilen zuordnen.
  
lz = Cells(Rows.Count, 2).End(xlUp).Row
If Cells(Rows.Count, 2) <> "" Then lz = Rows.Count
 
On Error Resume Next
For z = 2 To lz
For s = 3 To 3
        Cells(z, 1).Value = WorksheetFunction.VLookup(Cells(z, 6).Value, Range("Tabelle1!A:C"), s, False)
        If Err.Number > 0 Then
            Cells(z, 1).Value = 0
            Err.Clear
        End If
    Next s
Next z

' 19. Spalten N/V/Z als Währung formatieren
    Range("N:N,V:V,Z:Z").Select
    Range("Z1").Activate
    Selection.NumberFormat = "#,##0.00 $"
' 20. Unnötige Spalten entfernen
    Columns("AB:AG").Delete Shift:=xlToLeft
    Range("A1").Select
End Sub