rij automatisch verplaatsen

[Joey111]

Goedemiddag,

Ik wil dat alle regels die in kolom G de waarde EXI hebben worden verplaatst naar blad2.
Met onderstaande VBA heb ik aardig wat ik wil er is echter één probleem.
er worden maar een aantal regels verplaatst en niet allemaal, ik moet de vba meerdere malen uitvoeren voordat alle regels met waarde EXI zijn verplaatst.

kan iemand mij hiermee helpen?

Dim rij As Long
Dim n As Long
Dim src As Worksheet
Dim trg As Worksheet
Set src = Sheets("Blad1")
Set trg = Sheets("Blad2")
Application.ScreenUpdating = False
rij = trg.[G250].End(xlUp).Row + 1

For n = 1 To Blad1.[G250].End(xlUp).Row
If Cells(n, "G").Value = "EXI" Then
Range(Cells(n, "A"), Cells(n, "X")).copy
trg.Cells(rij, "A").PasteSpecial
Range(Cells(n, "A"), Cells(n, "X")).EntireRow.Delete

rij = rij + 1
End If
Next
Application.Goto [blad2!A1], True
Application.Goto [blad1!A1], True
Application.ScreenUpdating = True
End Sub

 

[SjonR]

Probeer dit eens:

Sub SjonR()
rij = Sheets("Blad2").Range("A" & Rows.Count).End(xlUp).Row + 1
With Sheets("Blad1").Cells(1).CurrentRegion
    .AutoFilter 7, "EXI"
    .Offset(1).SpecialCells(12).Copy
     Sheets("Blad2").Cells(rij, 1).PasteSpecial
    .Offset(1).SpecialCells(12).EntireRow.Delete
    .AutoFilter
End With

End Sub

als je jouw code van beneden naar boven laat werken zal het beter gaan.

 

[VenA]

@Joey111,
Lees dit even. http://www.helpmij.nl/forum/announcement.php?f=5

SjonR,
Specialcells(12) mag je ook weglaten en volgens mij doet de Pastespecial zonder extra argumenten niets.

Sub VenA()
  With Sheets("Blad1").Cells(1).CurrentRegion
    .AutoFilter 7, "EXI"
    .Offset(1).Copy Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    .Offset(1).EntireRow.Delete
    .AutoFilter
  End With
End Sub

 

[Joey111]

Bedankt voor de hulp het werkt nu perfect!

 

[OctaFish]

De reden dat je oude macro niet goed werkte, is omdat je in de verkeerde richting werkte. Als je begint met je lus haal je met Blad1.[G250].End(xlUp).Row een rijnummer op waar op dat moment nog wat in staat. Vervolgens voer je een routine uit die rijen verwijdert. Gevolg: de onderste rijen zijn na verloop van tijd leeg, en de rijen waar wél wat in staat (en dus ook jouw zoekteksten) zijn opgeschoven naar boven. Daar zitten dus ook rijnummers tussen waar bij het begin wél te verplaatsen rijen tussen stonden. Daarom eindig je dus met een blad waar nog steeds verkeerde records in staan, en moet je de routine nóg een keer uitvoeren. Werk je van onderen naar boven, dan gaat het wel goed:

    For n = Blad1.[G250].End(xlUp).Row To 1 Step -1

Neemt niet weg dat de aangedragen oplossingen waarschijnlijk beter werken .