Cellen horizontaal verplaatsen met Macro

[Moche56]

Mijn vraag is als volgt:
In een tab met veel regels wil ik met een macro een horizontaal verplaatsing van cellen indien een cel het woord “ja” bevat.
Dus als cel A1 = “ja”  D1 t/m M1 kopiëren naar C1 t/m L1 (in hetzelfde blad)
En dan de hele blad doorzoeken tot AXX (bijv: A5000)
Ik kan macro’s lezen en eenvoudige macro maken maar dit is net een stap verder voor mij.
Wie kan mij helpen?
Groeten,
Moché

 

[Cobbe]

Er zal toch een beetje meer info nodig zijn, vrees ik.

Maak een vb'tje, moeten alle cellen doorlopen worden tussen A1 en AXX5000 ?
En is de opdracht dan steeds dezelfde - 10 cellen 1 cel naar links schuiven?
Als dit de opdracht is hoef je enkel één cel te verwijderen - schuiven naar links en klaar.

 

[Moche56]

Reactie naar Cobbe

Hallo Cobbe,
Alvast bedankt voor je reactie.
Ik heb een voorbeeld gemaakt en hoop dat het duidelijker is.

Sorry, niet alle vragen zijn beantwoordt:
Ja er moeten steeds maar een gelijk aantal cellen naar links verplaatst worden.
zomaar verwijderen kan niet i.v.m. link naar formule. "copy" is daarom gewenst.
Grt,
Moché

Bekijk bijlage voorbeeld verplaatsen.xlsx

 

[Cobbe]

Als er geen verdere verrassingen uit de bus komen doet deze dat voor u:

Sub cobbe()
 With Sheets("Blad1")
   For cl = 1 To 5000
     If UCase(.Cells(cl, 1)) = "JA" Then
       .Cells(cl, 4).Delete Shift:=xlShiftToLeft
       .Cells(cl, 1) = "Klaar"
     End If
   Next
 End With
End Sub

 

[Cobbe]

Hier een 2de code als je echt wil kopiëren naar links:

Sub cobbe()
    With Sheets("Blad1")
        For cl = 1 To 5000
            If UCase(.Cells(cl, 1)) = "JA" Then
                .Range(.Cells(cl, 5), Cells(cl, 16)).Cut .Cells(cl, 4)
                .Cells(cl, 1) = "Klaar"
            End If
        Next
    End With
End Sub

 

[Moche56]

Hallo Cobbe,

Erg bedankt voor de hulp.
Het werkt in het test bestand maar niet in het bestand waar het nodig is.
De macro loopt vast omdat in de rijen die gekopieerd moeten worden staat "Ja" maar in andere rijen staan andere waarde die blijkbaar een conflict creëren (denk ik).
Concreet kan er een controle plaatsvinden die op "Ja" checkt en de rest overslaan?


Ik hoop dat je opnieuw kan helpen.

P.S. Ik heb .Cut gewijzigd in .Copy zodat de formules die deze cellen gebruiken niet een #Verw fout geven

Mvrg,
Moché

 

[Cobbe]

Snap niet direct wat er fout loopt maar de regel:

If UCase(.Cells(cl, 1)) = "JA" Then

kijkt in kolom A of er ofwel ja , Ja , jA, JA staat, indien geen van deze items in die cel staat loopt de code verder naar de volgende cel.

Post anders een voorbeeldje waarin dit fout loopt,
wellicht snap ik iets niet goed.

 

[Moche56]

Voorbeel

Hierbij een voorbeeld van de fout: laat de macro lopen aub

Bekijk bijlage BESTELMODULE test.xls

Alvast bedankt
Grt,
Moché

 

[Cobbe]

Je kan deze eens testen, maar deze loopt over de eventuele fout heen.
Anders moet je die #Verw eens uit cel F1206 halen want daar loopt die op vast.

Sub Cobbe()
[COLOR="#FF0000"]On Error Resume Next[/COLOR]
'Dim Response As VbMsgBoxResult
'Response = MsgBox("Grondstofbestellingen verplaatsen?", vbExclamation + vbYesNo, "Grondstof Planning")
'If Response = vbNo Then Exit Sub

    With Sheets("Grondstoffen")
        For cl = 1 To 4000
            If UCase(.Cells(cl, 6)) = "JA" Then
                .Range(.Cells(cl, 10), .Cells(cl, 19)).Copy .Cells(cl, 9)
               '.Cells(cl, 1) = "Klaar"
            End If
        Next
    End With
    
  'MsgBox "Bestellingen verplaatst.", vbInformation, "Moché"

End Sub

 

[Moche56]

Hallo Cobbe,
Het werkt perfect.
Je hebt vandaag een paar van mijn collega's gelukkig gemaakt.
Een keer per week moesten er veel rijen handmatig verplaatst worden.
Nu niet meer.
Super bedankt
Mvgr,
Bedankt