rijen verplaatsen naar ander tablad in functie van het resultaat in een kolom

[ingeVH]

Toepassing: automatiseren van klantcontacten zoals in bijgevoegd bestand
Bij het invoeren van een waarde "100" in kolom L, verhuist de volledige rij naar het tabblad "Closed".
(het zal je snel duidelijk worden, ik ben een echte "dummie" en dus een totale leek in programmeren!) De code hiervoor op het forum gevonden en via cut & paste in VBA werkt dit correct. :d

Nu moet ik met een extra voorwaarde de verplaatsing uitvoeren:
1) Zolang kolom "Status" (kolom "L") niet wordt ingevuld blijven de rijen in het oorspronkelijke tabblad "Screening" staan.
ik heb van kolom L een keuzelijst gemaakt: "Naar tabblad Closed", of "Naar tabblad Actief-Project".

2) invulkeuze in kolom L "Naar Actief-Project" of "Naar Closed", moet volgende actie geven: verplaatsing van de rij naar het respektievelijke tabblad. (en verwijderen van leeggekomen rij)

3) en idem van tablad "Actief-Project" naar "Closed" van zodra het project is afgewerkt

ik heb getracht de 2e voorwaarde toe te voegen in de code, maar dit blijkt dus (allicht ) niet te werken...

Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column = 12 Then
  If Target = "Naar Closed" Then
    Application.EnableEvents = False
      nxtRow = Sheets("Closed").Range("L" & Rows.Count).End(xlUp).Row + 1
       Target.EntireRow.Copy _
        Destination:=Sheets("Closed").Range("A" & nxtRow)
       Target.EntireRow.Delete

 If Target.Column = 12 Then
  If Target = "Naar Actief-Project" Then
    Application.EnableEvents = False
      nxtRow = Sheets("Actief-Project").Range("L" & Rows.Count).End(xlUp).Row + 1
       Target.EntireRow.Copy _
        Destination:=Sheets("Actief-Project").Range("A" & nxtRow)
       Target.EntireRow.Delete
  End If
 End If
 Application.EnableEvents = True
End Sub

hartelijk dank alvast mocht iemand mij willen helpen. Voorbeeldbestand in bijlage

 

[gast0660]

Probeer het eens met volgende code onder een knopje

Private Sub CommandButton1_Click()
lRow = Sheets("Screening").Range("A50000").End(xlUp).Row

For j = lRow To 1 Step -1

    If Sheets("Screening").Range("L" & j) = "Naar Actief-Project" Then
        cRow = Sheets("Actief-Project").Range("A50000").End(xlUp).Row
        Sheets("Screening").Rows(j).Copy Destination:=Sheets("Actief-Project").Range("A" & cRow + 1)
        Sheets("Screening").Rows(j).Delete
   End If

If Sheets("Screening").Range("L" & j) = "Naar Closed" Then
        cRow = Sheets("Closed").Range("A50000").End(xlUp).Row
        Sheets("Screening").Rows(j).Copy Destination:=Sheets("Closed").Range("A" & cRow + 1)
        Sheets("Screening").Rows(j).Delete
   End If
Next
End Sub

 

[ingeVH]

bedankt, ik vermoed dat ik iets fout doe:
keuzeknop VBA, code geplakt => bij het aanklikken van een keuze (noch in het tabblad "Screening", noch in het tablad "Actief-Project") volgt er geen actie.

 

[gast0660]

Voorzetje
Zet ergens in kolom L Closed of Naar Actief-Project en druk op een van de knopjes (in Blad Screening of Actief-Project)
Edit Naar Closed ipv Closed

 

[ingeVH]

fantastisch,
- bij verschillende benaming (bij tab"Screening" en tab"Actief-Project") voor verplaatsing naar tab"Closed" OK
- knopjes verplaatst naar de hoofding van de kolommen - werkt super correct!!
...zou je kunnen kussen ...dankje dankje dankje wel!!!:thumb:
rest nog 1 vraagje van de "dummie": hoe best te werk om deze instructies toe te passen (over te brengen) naar mijn werkelijk bestand?

 

[gast0660]

Euh, uw vb bestand zag er al redelijk werkelijk uit.
Knopjes plaatsen in uw echte bestand en onder de knopjes de code plakken (te vinden via ALT + F11 in mijn vbtje)
Een beetje uitleg bij de code:

lRow = Sheets("Screening").Range("A50000").End(xlUp).Row ' bladnaam waar de gegevens worden gezocht

For j = lRow To 1 Step -1

If Sheets("Screening").Range("L" & j) = "Naar Actief-Project" Then 'Naar actief-Project is de tekst in kolom L (vb, ls je AP wilt gebruiken verander dat hier)
cRow = Sheets("Actief-Project").Range("A50000").End(xlUp).Row 'Actief-Project is het blad waar de gegevens naar toe moeten
Sheets("Screening").Rows(j).Copy Destination:=Sheets("Actief-Project").Range("A" & cRow + 1) 'dit is van blad (oorsprong van de gegevens) naar blad (bestemming)
Sheets("Screening").Rows(j).Delete' de verplaatste gegevens worden gewist in het blad waar je de gegevens vandaan hebt gehaald
End If

Als er nog vragen zijn, laat maar weten
Dat kussen lijkt mij wel wat

 

[ingeVH]

:d

werkt perfect! Nogmaals bedankt!

 

[gast0660]

Mooi zo, daar doen we het toch voor:thumb:
suc6