Macro using too much memory

HansVogelaar Thank you very much! I changed the code as specified but unfortunately it still crashes when handling more data. Any further ideas? 🙂

Here the code so far:

Sub ActivateSheet()
Worksheets("DPW_reinkopieren").Activate
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
dpwlöschenkopierenfiltern
End Sub
Sub dpwlöschenkopierenfiltern()
'
' dpwlöschenkopierenfiltern Makro
'

'
    Application.CutCopyMode = False
    Columns("A:H").Delete Shift:=xlToLeft
    Columns("B:B").Delete Shift:=xlToLeft
    Columns("D:D").Delete Shift:=xlToLeft
    Columns("E:G").Delete Shift:=xlToLeft
    Columns("D:D").Select
    Selection.AutoFilter
    ActiveSheet.Range("$D$1:$D$136").AutoFilter Field:=1, Criteria1:= _
        "direkte TN/innen-bezogene Leis"
    Columns("A:C").Select
    Selection.Copy
    Sheets("DPW").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("LDP").Select
    
ActivateSheet2
    
End Sub
Sub ActivateSheet2()
Worksheets("LDP_reinkopieren").Activate

ldplöschenfiltern
End Sub

Sub ldplöschenfiltern()
'
' ldplöschenfiltern Makro
'

'
    Columns("A:A").Delete Shift:=xlToLeft
    Columns("D:H").Delete Shift:=xlToLeft
    Columns("E:H").Delete Shift:=xlToLeft
    Columns("A:D").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$D$1165").AutoFilter Field:=4, Criteria1:="<>"
    Columns("A:C").Select
    Selection.Copy
    Sheets("LDP_Nullen").Select
    Range("A1").Select
    ActiveSheet.Paste
    Columns("A:C").Select
    Application.CutCopyMode = False
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$C$1048408").AutoFilter Field:=3, Criteria1:=">0", _
        Operator:=xlAnd
    ActiveSheet.Range("$A$1:$C$1048408").AutoFilter Field:=2, Criteria1:=">0", _
        Operator:=xlAnd
    Columns("A:C").Select
    Selection.Copy
    Sheets("LDP").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("LDP").Select
    
Macro2

End Sub


Sub Macro2()
'
'
'

'
    Range("D2:D7").Select
    Selection.FormulaR1C1 = _
        "=IF(AND(RC[-3]=R[-1]C[-3],RC[-2]=R[-1]C[-1],R[-1]C<>""Delete""),""Delete"",IF(AND(R[1]C[-3]=RC[-3],R[1]C[-2]=RC[-1]),R[1]C[-1],RC[-1]))"

Macro1
End Sub

Sub Macro1()

On Error GoTo Quit

MyLoop:
LR = Cells(Rows.Count, 1).End(xlUp).Row

With Range("D2:D" & LR)
.FormulaR1C1 = _
        "=IF(AND(RC[-3]=R[-1]C[-3],RC[-2]=R[-1]C[-1],R[-1]C<>""Delete""),""Delete"",IF(AND(R[1]C[-3]=RC[-3],R[1]C[-2]=RC[-1]),R[1]C[-1],RC[-1]))"
.Value = .Value
.Offset(0, -1).Value = .Value

.SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete
End With

LR2 = Cells(Rows.Count, 1).End(xlUp).Row

If LR2 < LR Then GoTo MyLoop

Quit:
Range("D2:D" & LR).Clear

markierenLPD
End Sub

Sub markierenLPD()
'
' markierenLPD Makro
'

'
    Cells.Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:="=A1<>DPW!A1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
Application.ScreenUpdating = True
Application.EnableEvents = True

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub