Rijen plakken dmv VBA

[nmeijer]

Beste,

Ik maak gebruik van onderstaande code om coresponderende cellen te kopieren en in een tweede sheet te plakken:

Sub SpecialCopy()
    Dim rngAll As Range
    Dim rngCell As Range
    Dim rij As Integer
       
    Set rngAll = Range("B2:E11")
    
     For Each rngCell In rngAll.Cells
          If rngCell.Value = Range("G2") And rij < rngCell.Row Then
          Rows(rngCell.Row & ":" & rngCell.Row).Copy
          
        Sheets("Blad2").Select
        ActiveSheet.Paste
          Range("A15").Offset(1, 0).Select
          Sheets("Blad1").Select
        End If
    Next
    Application.CutCopyMode = False
End Sub

Hoe zorg ik er nu voor dat hij de eerste regel op rij 15 plakt en elke volgende regel op de eerste lege regel daarna?

Bvd,

 

[nmeijer]

Ik maak gebruik van deze code:

Sheets("Blad2").Range("A15").Select
ActiveSheet.Paste
Range("A15").Offset(1, 0).Select
Sheets("Blad1").Select

Maar krijg telkens de error 1004, select method of range class failed. Kan iemand me hiermee helpen?

 

[Warme bakkertje]

Sub SpecialCopy()
    Dim rngAll As Range, rngCell As Range, rij As Integer
    Set rngAll = Sheets("Blad1").Range("B2:E11")
    For Each rngCell In rngAll
        If rngCell.Value = Sheets("Blad1").Range("G2")  And rij < rngCell.Row Then
            With Sheets("Blad2")
                fRow = .Range("A" & .Rows.Count).End(xlUp).Row
                If fRow <= 14 Then fRow = 14
                .Range("A" & fRow + 1).Resize(, 4) = Sheets("Blad1").Cells(rngCell.Row, 2).Resize(, 4).Value
            End With
        End If
    Next
End Sub

En wat is rij ??

 

[nmeijer]

Dat weet ik ook niet precies, de basis van de macro komt van het forum.

Het plakken gaat nu goed alleen plakt hij het zoekbereik en niet de volledige rij?

Mvg,

 

[Warme bakkertje]

Dan kan je die 2de voorwaarde er al aflaten (onnodig).
Toch niet een ganse rij kopieëren zeker, van welke kolom tot welke kolom heb je gegevens staan ?

 

[nmeijer]

De intentie was om de hele rij te kopieren maar van kolom A tot P is voldoende.

 

[Warme bakkertje]

Sub SpecialCopy()
    Dim rngCell As Range, fRow As Integer
    For Each rngCell In Sheets("Blad1").Range("B2:E11")
        If rngCell.Value = Sheets("Blad1").Range("G2")  Then
            With Sheets("Blad2")
                fRow = .Range("A" & .Rows.Count).End(xlUp).Row
                If fRow <= 14 Then fRow = 14
                .Range("A" & fRow + 1).Resize(, 16) = Sheets("Blad1").Cells(rngCell.Row, 1).Resize(, 16).Value
            End With
        End If
    Next
End Sub

 

[nmeijer]

Dankje, hij werkt perfect

 

[Warme bakkertje]

OK :thumb:
Heb ondertussen code nog wat aangepast in Post #7.