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
Bookmarks