Rijen plakken dmv VBA

[nmeijer]

Betse,

Ik maak gebruik van onderstaande macro om rijen te kopieren die gelijk zijn aan een bepaalde cel. Nu wil ik dat de rijen telkens worden geplakt in sheet2, cel A1 en dan naar beneden (A2, A3, enz.), momenteel wordt alles in A1 geplakt namelijk, waar zit de fout?

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
          Range("A1").Select
          ActiveSheet.Paste
                  ActiveCell.Offset(1, 0).Select
          Sheets("Blad1").Select
        End If
    Next
    Application.CutCopyMode = False
End Sub

Bij voorbaat dank,

niels

 

[Cobbe]

A1,B1,C1 liggen naast elkaar en niet onder elkaar!!!! Zéér belangrijk!

 

[nmeijer]

Sorry dat had A1, A2, A3, enz. moeten zijn.
De rijen moeten weldegelijk onder elkaar worden geplakt.

Mvg,

 

[Cobbe]

Wil je ze toch onder elkaar, kan je deze eens testen:

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(2).Range("A" & Sheets(2).Range("B" & Sheets(2).Rows.Count).End(xlUp).Row + 1)
        End If
    Next
    
    Application.CutCopyMode = False
End Sub

 

[nmeijer]

Nu plakt hij de rijen in cel A2 en als de macro nogmaals wordt uitgevoerd plakt hij ze onder het resultaat van de vorige, de bedoeling is dat het resultaat telkens in de eerste cel wordt geplakt.

 

[Cobbe]

Ik heb geen Grieks-Latijn gedaan dit snap ik echt niet meer.

 

[nmeijer]

De macro kopieert een bereik op basis van de waarde in cel G2, deze selectie moet in sheet 2 worden geplakt dus beginnend in cel A1 en dan verder naar beneden.
Als de macro nogmaals (bijvoorbeeld met een andere waarde) wordt uitgevoerd moet de uitkomst weer in cel A1 geplakt worden.

 

[Cobbe]

Dit heb ik er nog van kunnen maken:

Sub SpecialCopy()
    Dim rngAll As Range
    Dim rngCell As Range
    Dim rij As Integer
    With Sheets(1)
    Set rngAll = .Range("B2:E11")
    For Each rngCell In rngAll.Cells
        If rngCell.Value = .Range("G2") And rij < rngCell.Row Then
          .Range(.Cells(rngCell.Row, 2), .Cells(rngCell.Row, 5)).Copy
          Sheets(2).Range("A1").PasteSpecial Paste:=xlPasteAll, Transpose:=True
        End If
    Next
    End With
    Application.CutCopyMode = False
End Sub