Kopiëren naar ander tabblad onder oude gegevens

[cissie1]

Hoi,

Om een lijst te maken met alle ingevoerde gegevens heb ik onderstaande code uit een ander topic gehaald en aangepast aan mijn bestand.
Wat ik wil ik dat als ik op een knop druk, dat de gegevens die ingevuld staan in tabblad "STAP 2" meteen ook gekopiëerd worden naar tabblad "Jaarlening".

Nu is het zo dat de hele rijen gekopiëerd worden. Ik wil graag dat alleen de kolommen B t/m G gekopiëerd worden.

Daarnaast plakt hij het alleen bovenaan in het tabblad "Jaarlening". Ik wil graag dat de al eerder geplakte gegevens in tabblad "Jaarlening" blijven staan en de nieuwe gegevens eronder worden aangevuld.

Kunnen jullie mij helpen?

Cissie

    Dim x      As Long
    Dim y      As Long
    Dim c      As Variant
    x = Sheets("STAP 2").Cells(Rows.Count, "D").End(xlUp).Row
    y = 1
    For Each c In Range("C3:C42")
        If c <> "zz" And c.Offset(, 8) <> "OK" Then
            c.Rows.EntireRow.Copy Sheets("Jaarlening").Range("A" & y).Offset(2, 0)
            c.Offset(, 8) = "OK"
            y = y + 1
        End If
    Next c

 

[Cobbe]

Zou deze aan al je wensen voldoen?

Sub cobbe()
 Dim x      As Long
    Dim y      As Long
    Dim c      As Variant
    With Sheets("STAP 2")
    x = .Cells(Rows.Count, "D").End(xlUp).Row
        For Each c In .Range("C3:C42")
       If c <> "" And c <> "zz" And c.Offset(, 8) <> "OK" Then
            Evrij = Sheets("Jaarlening").Range("A65500").End(xlUp).Row + 1
            .Range("B" & c.Row & ":G" & c.Row).Copy Sheets("Jaarlening").Range("A" & Evrij)
            c.Offset(, 8) = "OK"
       End If
    Next c
    End With
End Sub

 

[cissie1]

Zou deze aan al je wensen voldoen?

Sub cobbe()
 Dim x      As Long
    Dim y      As Long
    Dim c      As Variant
    With Sheets("STAP 2")
    x = .Cells(Rows.Count, "D").End(xlUp).Row
        For Each c In .Range("C3:C42")
       If c <> "" And c <> "zz" And c.Offset(, 8) <> "OK" Then
            Evrij = Sheets("Jaarlening").Range("A65500").End(xlUp).Row + 1
            .Range("B" & c.Row & ":G" & c.Row).Copy Sheets("Jaarlening").Range("A" & Evrij)
            c.Offset(, 8) = "OK"
       End If
    Next c
    End With
End Sub

Helaas voldoet deze nog niet helemaal aan mijn wensen... Het werkt niet helemaal.
Ik zal er een voorbeeld bij sturen:
http://www.mijnbestand.nl/Bestand-ZQAC7EF3HFJF.xlsm

De eerste reservering geeft hij bovenaan de rij materiaal etc. aan in plaats van de regel eronder. Bij de tweede reservering gaat het mis en plakt hij de gegevens er niet goed onder. Helaas geeft hij ook de waarden niet goed weer. Hoe kun je de uitkomsten plakken in plaats van de verwijzingen?

Ik hoop dat je me nog verder kunt helpen.

Cissie

 

[Cobbe]

Ik hoop dat het voldoet want anders is het wachten ga nu dineren.:thumb:

http://www.mijnbestand.nl/Bestand-7L8IXMYC3FUJ.rar

Gr. Cobbe

 

[Warme bakkertje]

Sub cobbe()
    Dim Evrij      As Long
    Dim c      As Variant
    With Sheets("STAP 2")
    For Each c In .Range("C3:C42")
       If c <> "" And c <> "zz" And c.Offset(, 8) <> "OK" Then
            Evrij = Sheets("Jaarlening").Range("A65500").End(xlUp).Row + 1
            Sheets("Jaarlening").Range("A" & Evrij).Resize(, 6) = .Cells(c.Row, 2).Resize(, 6).Value
            c.Offset(, 8) = "OK"
       End If
    Next c
    End With
End Sub

 

[cissie1]

http://www.mijnbestand.nl/Bestand-7L8IXMYC3FUJ.rar

Gr. Cobbe[/QUOTE]


Bedankt!

Ik heb deze code gebruikt!!

 Application.ScreenUpdating = False
     Dim c      As Variant
     With Sheets("STAP 2")
     For Each c In .Range("C3:C42")
           If c <> "" And c <> "zz" And c.Offset(, 8) <> "OK" Then
                Rij = c.Row
             Evrij = Sheets("Jaarlening").Range("A65500").End(xlUp).Row + 1
                .Range("B" & Rij & ":G" & Rij).Copy
             Sheets("Jaarlening").Range("A" & Evrij).PasteSpecial Paste:=xlValues
         c.Offset(, 8) = "OK"
         End If
     Next c
     End With
    Application.ScreenUpdating = True

Dit werkt voor mij!!

Nu ben ik alleen bezig met het weghalen van 'OK' wanneer er bij STAP 1 de ophaaldatum (P1), terugbrengdatum (P2) en/of de naam (R1) verandert.
Ik ben begonnen met eerst één voorwaarde en één cel die aangepast zou moeten worden, alleen krijg ik deze niet werkend, dus kan ik hem ook niet uitbreiden naar wat ik echt wil. Kun je me hier alsjeblieft ook nog mee helpen?

Uiteindelijk wil ik dat de hele kolom K in sheet STAP 2 geleegd wordt als één of meerdere van de eerder genoemde waarden worden veranderd.

Dit is de code waarvan ik hoopte dat het zou werken:

Private Sub Worksheet_Deactivate()
    If Value.Sheet("STAP 1" & Range("P1")) <> Value.Sheet("STAP 2" & Range("E3")) Then
    Value.Sheet("STAP 2" & Range("K3")) = ""
    End If
End Sub

Vriendelijke groeten,
Cissie