Option
Explicit
Dim
rng
As
Range
Sub
ZeilenEinfügen()
Dim
Entscheidung$
Set
rng = Range(Rows(1), Rows(10))
rng.Insert Shift:=xlDown
rng.
Select
Entscheidung = MsgBox(
"Zeilen wieder löschen?"
, vbYesNo)
If
Entscheidung = vbYes
Then
rng.Rows.Delete
End
If
End
Sub
Sub
Abrechnungsammeln()
Dim
WS
As
Worksheet
Dim
WSz
As
Worksheet
Dim
Zeile
As
Long
Dim
i
As
Long
Dim
n
As
Long
Dim
Val1, Val2
On
Error
GoTo
ENDE
Application.ScreenUpdating =
False
Set
WSz = Worksheets(
"SAP"
)
n = 3
WSz.Range(n &
":"
& WSz.Rows.Count).Clear
For
Each
WS
In
ThisWorkbook.Worksheets
With
WS
Select
Case
.Name
Case
"SAP"
Case
Else
If
Not
IsEmpty(.UsedRange)
Then
For
Zeile = 120
To
130
Val1 = .Cells(Zeile, 5).Value
Val2 = .Cells(Zeile, 6).Value
If
Val1 > 0
And
IsNumeric(Val1)
Then
.Rows(Zeile).Copy
WSz.Cells(n, 1).PasteSpecial (xlPasteValuesAndNumberFormats)
n = n + 1
ElseIf
Val2 > 0
And
IsNumeric(Val2)
Then
.Rows(Zeile).Copy
WSz.Cells(n, 1).PasteSpecial (xlPasteValuesAndNumberFormats)
n = n + 1
End
If
Next
Zeile
End
If
End
Select
End
With
Next
Application.CutCopyMode =
False
ENDE:
Application.ScreenUpdating =
True
If
Err
Then
MsgBox Err.Description, ,
"Fehler: "
& Err
End
Sub