Als gedeelte uit een cel gelijk is aan, dan copy plaatsen

[HWV]

Beste,

Wat ik wil bereiken is het volgende.
Ik heb een bestand met artikelnummers, achter sommige artikelnummers heb ik -X staan.
Nu wil ik een copy van deze artikelnummers met een -X erachter plaatsen op een andere werkblad.

Ik dacht zelf aan zoiets hier beneden maar het werkt niet,
Hij moet zooeken vanaf rechts.

Zonder VBA is het mogelijk maar ik wil het verwerken in een sheet waar ik al werk met VBA

Sub Verplaatsen_X()

For i = 1 To Range("A65000").End(xlUp).Row
   If Right.Cells(i, 1) = "X" Then
   Cells(i, 1).Copy
   Sheets("Opslag  X").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
   End If
Next i

End Sub

Groet HWV

 

[Hoornvan]

HWV,

Ik heb niet in je bestandje gekeken maar je kunt toch filteren op de X en dat copieren?

 

[HWV]

Stap verder gekomen

Sub Verplaatsen_X()

    Sheets("ArtikelConversie Output").Select
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="=*-X", Operator:=xlAnd
    Sheets("ArtikelConversie Output").Range("A2:IV6500").Copy Sheets("Opslag  X").Range("A2:IV6500")
    Selection.AutoFilter
End Sub

Bedankt,

Ik ben een stuk verder gekomen met je tip. Het zal niet de beste code zijn want deels met de macro opgenomen om te kijken wat er gebeurde. Maar het werkt perfect op deze manier. Als iemand een beter code weet hou ik me graag aanbevolen.

Groet HWV

 

[snb]

Sub Verplaatsen_X()
  For each cl in sheets("Blad1").columns(1).specialcells(2)
     If right(cl, 1) = "X" Then Sheets("Opslag  X").cells(Rows.Count,1).End(xlUp).Offset(1)=cl.value
  Next 
End Sub

 

[HWV]

Het werkt

Bedankt SNB,

Het werkt weer, zodat ik het verder kan verwerken


groet HWV