Kopieren en plakken gelijktijdig op meerdere sheets (voorwaarden zijn gelijk) mbv vba

[kruimeltjes]

Goedemorgen allemaal,

Ik ben al een tijdje op zoek naar een vba codering waarmee ik al mijn sheets (6 stuks, met dezelfde datagegevens en formats) tegelijkertijd (of tenminste achter elkaar) kan sorteren gebaseerd op een gedeelte van de naamgeving.

Ik heb een code die werkt (zie hieronder) maar die werkt alleen maar op de op dat moment actieve sheet. Kan ik dit zo maken dat die het voor alle sheets gaat doen?

For Each WSH In ThisWorkbook
    Range("A1:A3000").Select
        Cells.Find(What:="_2_?_?", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A7000").Select
[COLOR="#FF0000"]    WSH.Paste[/COLOR]
Next
End Sub

Mijn vermoede is dat het gemarkeerde stuk het probleem geeft.

 

[kruimeltjes]

Problem Solved en wel zo;

For Each WSH In ThisWorkbook.Sheets
    Range("A1:A3000").Select
        Cells.Find(What:="_2_?_?", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Cut
    Range("A7000").Select
    ActiveSheet.Paste
    Worksheets(ActiveSheet.Index + 1).Select
Next