Thema Datum  Von Nutzer Rating
Antwort
13.10.2011 08:35:38 Birnenbaum
NotSolved
13.10.2011 09:22:47 till
NotSolved
13.10.2011 10:58:53 Gast10689
NotSolved
13.10.2011 11:03:16 Birnenbaum
NotSolved
13.10.2011 12:01:48 Birnenbaum
NotSolved
13.10.2011 12:41:16 Dekor
NotSolved
13.10.2011 12:56:19 Birnenbaum
NotSolved
13.10.2011 14:06:21 Dekor
NotSolved
13.10.2011 15:44:14 Birnenbaum
NotSolved
13.10.2011 16:20:27 Dekor
NotSolved
Rot Wenn Wert größer 0 dann kopieren ohne Formeln
13.10.2011 23:06:08 Till
Solved
14.10.2011 07:28:43 Birnenbaum
NotSolved

Ansicht des Beitrags:
Von:
Till
Datum:
13.10.2011 23:06:08
Views:
1859
Rating: Antwort:
 Nein
Thema:
Wenn Wert größer 0 dann kopieren ohne Formeln

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...


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
13.10.2011 08:35:38 Birnenbaum
NotSolved
13.10.2011 09:22:47 till
NotSolved
13.10.2011 10:58:53 Gast10689
NotSolved
13.10.2011 11:03:16 Birnenbaum
NotSolved
13.10.2011 12:01:48 Birnenbaum
NotSolved
13.10.2011 12:41:16 Dekor
NotSolved
13.10.2011 12:56:19 Birnenbaum
NotSolved
13.10.2011 14:06:21 Dekor
NotSolved
13.10.2011 15:44:14 Birnenbaum
NotSolved
13.10.2011 16:20:27 Dekor
NotSolved
Rot Wenn Wert größer 0 dann kopieren ohne Formeln
13.10.2011 23:06:08 Till
Solved
14.10.2011 07:28:43 Birnenbaum
NotSolved