Hi guys,

I'm trying to use the macro below (twice but with different variables) but everytime I get the error "Compile error: Constant expression required". Does anyone know why?

Sub main()
    Call SplitDam
    Call ASSS
End Sub
Sub SplitDam()

' alle cellen unmergen
    Dim wSheet As Worksheet
     
    For Each wSheet In Worksheets
        wSheet.UsedRange.UnMerge
    Next wSheet

Const fWhat As String = "Dama"
Dim R As Range, fAdr As String, nR As Long, cutRng As Range, Ar As Range
With Sheets("Totaal")
    Set R = .Range("E:E").Find(fWhat, [E1], xlFormulas, xlPart, , , False)
    If Not R Is Nothing Then
        fAdr = R.Address
        Set cutRng = R.Offset(0, -4).Resize(1, .UsedRange.Columns.Count)
        Do
            Set R = .Range("E:E").FindNext(R)
            If R Is Nothing Then Exit Do
            If R.Address = fAdr Then Exit Do
            Set cutRng = Union(cutRng, R.Offset(0, -4).Resize(1, .UsedRange.Columns.Count))
        Loop
    End If
    If Not cutRng Is Nothing Then
        nR = 1
        For Each Ar In cutRng.Areas
            Ar.Cut Destination:=Sheets(.Index + 1).Range("A" & nR)
            nR = Sheets(.Index + 1).Range("A" & Rows.Count).End(xlUp).Row + 1
        Next Ar
    End If
End With

On Error Resume Next
Columns("N").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub
Sub ASSS()
' alle cellen unmergen
    Dim wSheet As Worksheet
     
    For Each wSheet In Worksheets
        wSheet.UsedRange.UnMerge
    Next wSheet

Const fWhat As String = "AS"
Dim R As Range, fAdr As String, nR As Long, cutRng As Range, Ar As Range
With Sheets("Totaal")
    Set R = .Range("N:N").Find(fWhat, [N1], xlFormulas, xlPart, , , False)
    If Not R Is Nothing Then
        fAdr = R.Address
        Set cutRng = R.Offset(0, -4).Resize(1, .UsedRange.Columns.Count)
        Do
            Set R = .Range("N:N").FindNext(R)
            If R Is Nothing Then Exit Do
            If R.Address = fAdr Then Exit Do
            Set cutRng = Union(cutRng, R.Offset(0, -4).Resize(1, .UsedRange.Columns.Count))
        Loop
    End If
    If Not cutRng Is Nothing Then
        nR = 1
        For Each Ar In cutRng.Areas
            Ar.Cut Destination:=Sheets(.Index + 2).Range("A" & nR)
            nR = Sheets(.Index + 2).Range("A" & Rows.Count).End(xlUp).Row + 1
        Next Ar
    End If
End With

On Error Resume Next
Columns("N").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub