VisualBasic Excel - Zellen kopieren mit Bedingung

[Nico_B]

Hallo.

Ich möchte gerne aus einer Liste alle Werte der Spalte A auf ein zweites Tabellenblatt (Spalte A) kopieren, wenn in der Spalte E Wert größer 0 vorliegt und anschließend dazu noch die Werte aus E nach auf dem zweiten Tabellenblatt. Leider klappt es nicht so wie es mir vorstelle. Könnt ihr mir helfen?

Sub Rechnungsdatenerstellen()

Dim i As Long, j As Long
Dim AR1 As Long, AR2 As Long

'Parameter für den Zielbereich
eZ = Worksheets("Optionen").Range("B111").Value 'erste Zeile
lZ = Worksheets("Optionen").Range("112").Value 'letze Zeile
eS = Worksheets("Optionen").Range("105").Value 'erste Spalte
lS = Worksheets("Optionen").Range("106").Value 'letzte Spalte

AR1 = Worksheets("Optionen").Range("B88").Value   'erste Zeile der Quelldaten
AR2 = Worksheets("Optionen").Range("B89").Value   'letzte Zeile der Quelldaten

j = eZ

With Worksheets("Abrechnungexport")
    For i = AR1 To AR2
        If .Cells(i, 5) > 0 Then
            .Range("A" & i).Copy _
                 Destination:=Worksheets("Rechnungsvorblatt").Range("A" & j)
            j = j + 1
        End If
    Next i
End With

With Worksheets("Abrechnungexport")
    For i = AR1 To AR2
        If .Cells(i, 5) > 0 Then
            .Range("E" & i).Copy _
                 Destination:=Worksheets("Rechnungsvorblatt").Range("D" & j) 
            j = j + 1
        End If
    Next i
End With

End Sub

 

[Alchemist]

Hi,

ich finde zwei Sachen, zum einen fehlen bei lZ eS lS die "B" in der Range.

Das zweite wird dein Problem verursachen, du trennst das Kopieren von A und E, daher verschieben sich die Werte. Ich nehme an du hast eine Ausgabe, bei der die Werte in der D Spalte genau dort anfangen, wo die Werte der A Spalte aufgehört haben?! Richtig?
Daher das Kopieren zusammenziehen, also
.Range("E" & i).Copy Destination:=Worksheets("Rechnungsvorblatt").Range("D" & j)
mit in die erste Schleife nehmen. Den Ganzen unteren Teil kannst du dann löschen.

VG

Sub Rechnungsdatenerstellen()

Dim i As Integer, j As Integer
Dim AR1 As Integer, AR2 As Integer

'Parameter für den Zielbereich
eZ = Worksheets("Optionen").Range("B111").Value 'erste Zeile
lZ = Worksheets("Optionen").Range("B112").Value 'letze Zeile
eS = Worksheets("Optionen").Range("B105").Value 'erste Spalte
lS = Worksheets("Optionen").Range("B106").Value 'letzte Spalte

AR1 = Worksheets("Optionen").Range("B88").Value   'erste Zeile der Quelldaten
AR2 = Worksheets("Optionen").Range("B89").Value   'letzte Zeile der Quelldaten

j = eZ

With Worksheets("Abrechnungexport")
    For i = AR1 To AR2
        If .Cells(i, 5) > 0 Then
            .Range("A" & i).Copy _
                 Destination:=Worksheets("Rechnungsvorblatt").Range("A" & j)
            .Range("E" & i).Copy _
                 Destination:=Worksheets("Rechnungsvorblatt").Range("D" & j) 
            j = j + 1
        End If
    Next i
End With

End Sub

 

[alxtraxxx]

Zum Einen hast Du in Deinen Ranges keine Spalten angegeben und zum Anderen würde ich mir das Benutzen undeklarierter Variablen abgewöhnen das erschwert das Debuggen nur. Immer brav Option Explicit benutzen, das hilft schon einmal 90% der Fehler zu vermeiden.
Das Makro stoppt doch sogar auch direkt bei dem Fehler

lZ = Worksheets("Optionen").Range("112").Value 'letze Zeile

Vermutlich meintest Du überall Range("B usw

 

[Nico_B]

Hallo.

Vielen Dank. Das hat mir schon weitergeholfen. Leider bekomme ich es nicht hin, dass er mir nur die Werte kopiert und nicht die Formeln:

Sub Rechnungsdatenerstellen()
 
Dim i As Integer, j As Integer
Dim AR1 As Integer, AR2 As Integer
 
'Parameter für den Zielbereich
eZ = Worksheets("Optionen").Range("B111").Value 'erste Zeile
lZ = Worksheets("Optionen").Range("B112").Value 'letze Zeile
eS = Worksheets("Optionen").Range("B105").Value 'erste Spalte
lS = Worksheets("Optionen").Range("B106").Value 'letzte Spalte
 
AR1 = Worksheets("Optionen").Range("B88").Value   'erste Zeile der Quelldaten
AR2 = Worksheets("Optionen").Range("B89").Value   'letzte Zeile der Quelldaten
 
j = eZ
 
With Worksheets("Abrechnungexport")
    For i = AR1 To AR2
        If .Cells(i, 3) > 0 Then
            .Range("A" & i).Copy _
                 Destination:=Worksheets("Rechnungsvorblatt").Range("D" & j)
            .Range("E" & i).Copy
                 Worksheets("Rechnungsvorblatt").Range("A" & j).PasteSpecial Paste:=xlPasteValues
            j = j + 1
        End If
    Next i
End With
 
End Sub

Schon erledigt Fehler gefunden!