hallo zusammen,
mein makro sucht in spalte a nach den zahlen 1 bis 10
und gruppiert dies dann, ich bekomme allerdings eine
fehlermeldung wenn die zahlen nur z.b. von 1-8 gehen.
ich möchte das das makro bei einem fehler einfach aufhört,
es müsste doch einen befehl geben mit exit
Sub oder?
danke und gruß stefan
das ist mein makro:
Sub ZeilenMarkierenUndGruppieren()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 As Range
Dim rng6 As Range
Dim rng7 As Range
Dim rng8 As Range
Dim rng9 As Range
Dim rng10 As Range
Dim iRow As Integer, iRowL As Integer, nP As Integer
iRowL = Cells.Find(what:="1", after:=Range("A10"), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = 1 To iRowL
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng1 Is Nothing Then
Set rng1 = Rows(iRow)
Else
Set rng1 = Union(rng1, Rows(iRow))
End If
End If
Next iRow
rng1.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="2", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng2 Is Nothing Then
Set rng2 = Rows(iRow)
Else
Set rng2 = Union(rng2, Rows(iRow))
End If
End If
Next iRow
rng2.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="3", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng3 Is Nothing Then
Set rng3 = Rows(iRow)
Else
Set rng3 = Union(rng3, Rows(iRow))
End If
End If
Next iRow
rng3.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="4", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng4 Is Nothing Then
Set rng4 = Rows(iRow)
Else
Set rng4 = Union(rng4, Rows(iRow))
End If
End If
Next iRow
rng4.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="5", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng5 Is Nothing Then
Set rng5 = Rows(iRow)
Else
Set rng5 = Union(rng5, Rows(iRow))
End If
End If
Next iRow
rng5.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="6", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng6 Is Nothing Then
Set rng6 = Rows(iRow)
Else
Set rng6 = Union(rng6, Rows(iRow))
End If
End If
Next iRow
rng6.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="7", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng7 Is Nothing Then
Set rng7 = Rows(iRow)
Else
Set rng7 = Union(rng7, Rows(iRow))
End If
End If
Next iRow
rng7.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="8", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng8 Is Nothing Then
Set rng8 = Rows(iRow)
Else
Set rng8 = Union(rng8, Rows(iRow))
End If
End If
Next iRow
rng8.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="9", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng9 Is Nothing Then
Set rng9 = Rows(iRow)
Else
Set rng9 = Union(rng9, Rows(iRow))
End If
End If
Next iRow
rng9.Select
Selection.Rows.Group
nP = iRowL + 2 'neu Position
iRowL = Cells.Find(what:="10", after:=Range("A" & nP), _
searchorder:=xlByRows, searchdirection:=xlPrevious).Row
For iRow = nP To iRowL 'ab neu Position
If WorksheetFunction.CountA(Rows(iRow)) > 0 Then
If rng10 Is Nothing Then
Set rng10 = Rows(iRow)
Else
Set rng10 = Union(rng10, Rows(iRow))
End If
End If
Next iRow
rng10.Select
Selection.Rows.Group
End Sub