Rijen met een bepaalde voorwaarden autmatisch kopieëren naar ander tabblad.

[ChanelMademoisell]

Hallo Allemaal,
Ik heb een soortgelijke vraag als deze. Ik wil namelijk in mijn overzicht klant gegevens dat er gegevens automatisch worden gekopieerd naar een ander tabblad. Waneer er in kolom 1 een "x" staat moet de rij worden gekopieerd naar "nog leveren", wanneer er een "b" staat naar tabblad "binnen", bij een "g" naar "geleverd" en bij een "s" naar "service".
Bij de eerste x=nog leveren is het me nu gelukt. Echter wanneer ik de waarde x aanpas wordt deze niet verwijderd uit het tabblad nog geleverd. Graag wil ik dat wanneer de x bijvoorbeeld een b (voor binnen) wordt, de regel uit "nog leveren" wordt verwijderd en word gekopieerd naar tabblad "binnen". Ook lukt het me nu niet om het script werkende te krijgen voor de overige tabbladen. Hoe moet ik het weergeven in vba om dit voor elkaar te krijgen. Wanneer ik een nieuw script onder dit plak dan werkt het niet. Ik ben echt een noob op dit gebied dus alle hulp is welkom.

Wat is dus wil is dat de regels met bij behorende waarde naar bijbehorend tabblad worden gekopieerd en dat wanneer een waarde x,b,g,s in de klantgegevens wordt aangepast dat dan dit in het tabblad ook veranderd. Dus verwijderen uit het tabblad met de verwijderde waarde en verplaatsen naar het tabblad met de huidige waarde.

Hopelijk is dit mogelijk en kan iemand mij hierbij helpen.

Groetjes,

 

[wampier]

Het is wel mogelijk maar de performance bij grote lijsten zal niet super zijn. Op de lange termijn is de performance van elk tabblad individueel opnieuw opbouwen mogelijk wel beter dan telkens verplaatsen als je de letter veranderd.

Zolang je accepteert dat het met veel items op deze manier langzaam kan worden:

Private Sub Worksheet_Change(ByVal Target As Range)

 If Not Intersect(Target, [a:a]) Is Nothing Then
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    For Each scherm In Sheets
        If scherm.Name <> "Klantgegevens" Then
            Set resultaat = scherm.[b:b].Find(Target.Offset(0, 1).Value)
            If Not resultaat Is Nothing Then
                resultaat.EntireRow.Delete
            End If
        End If
        
    Next scherm
    If UCase(Target.Value) = "X" Then
        Target.EntireRow.Copy Sheets("nog leveren").[a50000].End(xlUp).Offset(1)
    End If
    If UCase(Target.Value) = "B" Then
        Target.EntireRow.Copy Sheets("binnen").[a50000].End(xlUp).Offset(1)
    End If
    If UCase(Target.Value) = "G" Then
        Target.EntireRow.Copy Sheets("geleverd").[a50000].End(xlUp).Offset(1)
    End If
    If UCase(Target.Value) = "S" Then
        Target.EntireRow.Copy Sheets("service").[a50000].End(xlUp).Offset(1)
    End If
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 End If
End Sub