Bei dem was du hier reinkopiert hast scheint ein Leerzeichen drinnen zu sein. Folgender Code sollte nur bei nur bei numerischen Werten > 0 etwas kopieren:
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 'Startzeile in "SAP"
WSz.Range(n & ":" & WSz.Rows.Count).Clear
For Each WS In ThisWorkbook.Worksheets
With WS
Select Case .Name
Case "SAP" 'hier die Tabellen eintragen die nicht berücksichtigt werden
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
Ansonsten kann ich mir nur vorstellen, dass du vielleicht die Sheets verwechselt hast...
|