Verplaatsen van rijen afhankelijk van waarde

[VBA_]

Hoi!

Mijn data is je hebt een pool van mensen die je wilt bellen voor bepaalde onderwerpen. Dus bijv Piet wil je als eerste bellen en heeft label met tekst A1. Tweede keus is Jan en heeft tekst A2 etc. Voor een ander onderwerp wil ik als eerste Kim bellen en heeft label met tekst B1. Tweede keus is Lies en heeft tekst B2.
Het zou heel fijn zijn als Piet (A1) nee zegt dat Jan (A2) direct verschoven worden naar de plek van Piet. Dan zou het ook fijn zijn dat de reserve A3 verschoven wordt naar plek van A2. Nu is plek met tekst A3 leeg die opgevuld moet worden met A4 uit een ander tabblad.

Ik zou dus willen dat alles automatisch doorschuift afhankelijk of iemand nee zegt.

Ik ben bezig met een VBA code om dit uit te laten voeren. Het lukt alleen nog niet. Op dit moment heb ik deze VBA code. Hij verplaatst nu de rij naar 59 alleen de tekst blijft staan waar die uit verplaatst is. Kortom het staat er nu dubbel in. Deze code heb ik samen met AI gemaakt aangezien ik niet bedreven ben met VBA

Sub ReplaceWithSuccessorAndArchiveFinal()
    Dim ws As Worksheet
    Dim targetRow As Long
    Dim i As Long, k As Long
    Dim currentCode As String, nextCode As String
    Dim baseCode As String
    Dim foundCount As Long
    Dim destinationRow As Long
    Dim lastRowFromTarget As Long
    Dim matchFound As Boolean
    
    Set ws = ThisWorkbook.Sheets("Blad1")
    targetRow = 59
    foundCount = 0
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    ' Bepaal de eerste vrije plek in het archief vanaf rij 59
    lastRowFromTarget = ws.Cells(ws.Rows.Count, "Z").End(xlUp).Row
    If lastRowFromTarget < targetRow Then
        destinationRow = targetRow
    Else
        destinationRow = lastRowFromTarget + 1
    End If
    
    ' Loop door het EERSTE BLOK (Rij 17 t/m 32) van ONDER naar BOVEN
    For i = 32 To 17 Step -1
        If Not IsError(ws.Cells(i, "Z").Value) Then
            ' Als er "nee" is ingevuld bij de hoofdpersoon
            If LCase(Trim(CStr(ws.Cells(i, "Z").Value2))) = "nee" Then
                
                ' Haal de code op uit kolom A (bijv. "A1")
                currentCode = Trim(CStr(ws.Cells(i, "A").Value))
                
                If currentCode <> "" Then
                    ' Bouw de code voor de opvolger (vervang de 1 aan het einde door een 2)
                    baseCode = Left(currentCode, Len(currentCode) - 1)
                    nextCode = baseCode & "2"
                    
                    ' 1. ARCHIVEREN: Kopieer de volledige rij eerst veilig naar het archief (rij 59+)
                    ws.Rows(i).Copy Destination:=ws.Rows(destinationRow)
                    ' Zet kolom A in het archief vast als harde waarde zodat de historie klopt
                    ws.Cells(destinationRow, "A").Value = ws.Cells(i, "A").Value
                    
                    destinationRow = destinationRow + 1
                    foundCount = foundCount + 1
                    
                    ' 2. RUILEN: Zoek in het TWEEDE BLOK (Rij 33 t/m 52) naar de opvolger (bijv. "A2")
                    matchFound = False
                    For k = 33 To 52
                        If Trim(CStr(ws.Cells(k, "A").Value)) = nextCode Then
                            
                            ' CRUCIAL FIX: Kopieer ALLEEN kolommen B t/m AC. Kolom A (de INDEX formule) blijft staan!
                            ws.Range(ws.Cells(k, "B"), ws.Cells(k, "Z")).Copy _
                                Destination:=ws.Cells(i, "B")
                            
                            ' Wis de kolommen B t/m Z van de reserve in het tweede blok
                            ws.Range(ws.Cells(k, "B"), ws.Cells(k, "Z")).ClearContents
                            
                            matchFound = True
                            Exit For ' Match verwerkt, stop met zoeken in blok 2 voor deze rij
                        End If
                    Next k
                    
                    ' Veiligheid: Mocht er geen reserve zijn gevonden, wis dan de kolommen van de hoofdpersoon
                    If Not matchFound Then
                        ws.Range(ws.Cells(i, "B"), ws.Cells(i, "Z")).ClearContents
                    End If
                    
                End If
            End If
        End If
    Next i
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "Klaar! " & foundCount & " rij(en) gearchiveerd. De bijbehorende reserves (A2, B2, etc.) hebben direct de oude plaats ingenomen!", vbInformation
End Sub

In rij 17-30 staan formules met verwijzingen om waardes uit een ander tabblad te halen. Het belangrijkste is kolom A. Daar staat tekst A1, B1, C1 (deze tekst komt uit een formule die deze gegevens uit ander tabblad haalt). De rijen zijn dus ook gesorteerd op A1, B1, C1 etc.

In rij 33-52 staan formules met verwijzingen om waardes uit een ander tabblad te halen (zoals die hierboven). Dit is dezelfde type informatie als in rij 17-30. In kolom A staat A2, A3, B2, B3 etc.

Mijn wens: als de waarde in kolom Z "Nee" staat (ook weer formule) dan moet het verplaatst worden naar rij 59 of lager (de rijen komen onder elkaar te staan). Deze plek moet dan worden opgevuld met vervolgnr. Dus als rij met tekst A1 (uit kolom A) wordt verplaatst moet tekst A2 uit rij 33-52 naar rij 17-30 verplaatst worden.
Wanneer deze rij met tekst A2 verplaatst is moet de rij eronder met tekst A3 op de oude plek van tekst A2 komen. Nu is de plek van tekst A3 open en die moet opgevuld worden uit tabblad 1 rij N. Na tekst A3 komt tekst A4. Die moet dan op de plek komen van tekst A3. Dit vindt plaats in rij 33-52.

Dit is best een lastige VBA code. Ik weet ook niet of Excel dit überhaupt kan. Ik hoop dat jullie mij hiermee kunnen helpen!

Alvast bedankt!

 

[snb]

Ik zie niets in rij 17-30 staan.

 

[VBA_]

' Loop door het EERSTE BLOK (Rij 17 t/m 32) van ONDER naar BOVEN

daar staat de informatie voor rij 17-30. Blijkbaar in de code staat 17-32. Dat is ook helemaal prima.

 

[snb]

Lees mijn bericht nog eens rustig door.