rij kopiëren van werkblad naar een andere variabel werkblad

[Cordo]

Wie ken mij helpen aub

Ik ben al een poos aan het klooien met allerlei verschillende codes niet altijd met succes.

Ik moet een rij kopiëren van A tot AZ uit een werkblad naar een andere werkblad met de naam die staan vermeld in kolom AE en naar de zelfde naam werkblad als naam uit kolom AE.
Ook moet deze kijken of er nog gegevens ontbreken of al gekopieerd zijn
Wie ken en wil mij helpen met dit stukje code

 

[edmoor]

Dat zijn er wel een aantal hier.
Maar plaats wel een voorbeeld document.

 

[Cordo]

ik zit al aan paar dagen te zoeken en te knutselen maar het lukt me maar niet om het goed te krijgen. hij pak maar 2 regels of alles met alle namen of dubbel.

ken wel wat voorbeelden laten zien maar daar gaat niemand wijzer van worden lol.
dus zou het erg op prijs stellen.

 

[edmoor]

Het gaat ook niet om je code maar om een voorbeeld van de gegevens in dat document.
In neem aan dat je dat wel "kan" doen.

 

[Cordo]

voorbeeld

dit is het wat elke keer omgezet moet worden. heb per debitnaam een sheet en de namen veranderen nog al.

 

[Cordo]

ik heb nu deze code met hulp.

Sub rowcopy_mod()
Const FirstRow = 5
Dim rij As Long
Dim n As Long
Dim src As Worksheet
Dim trg As Worksheet


Set src = Sheets("Ridon 22")


Application.ScreenUpdating = False

For n = FirstRow To src.Cells(Rows.Count, "AE").End(xlUp).Row
Set trg = Nothing
If src.Cells(n, "AE").Value <> "" Then
On Error Resume Next
Set trg = Worksheets(src.Cells(n, "AE").Value & " 22")

If Err = 0 Then
rij = trg.Cells(Rows.Count, "E").End(xlUp).Row + 1
With src
.Range(.Cells(n, "A"), .Cells(n, "AZ")).Copy
End With
trg.Cells(rij, "A").PasteSpecial
Else
Err.Clear
Set trg = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
trg.Name = src.Cells(n, "AE").Value & " 22"
With src
.Range(.Cells(1, "A"), .Cells(4, "AZ")).Copy
End With
trg.Cells(1, "A").PasteSpecial
rij = trg.Cells(Rows.Count, "A").End(xlUp).Row + 1
With src
.Range(.Cells(n, "A"), .Cells(n, "AZ")).Copy
End With
trg.Cells(rij, "A").PasteSpecial
End If
End If
Next n
On Error GoTo 0

Application.ScreenUpdating = True

End Sub[FONT=&amp]

maar ik krijg nog duplicaten bij het uitvoeren van deze.
er zou een controle moeten zijn over deze 4 cellen [/FONT][FONT=&amp]B,E, H, AD, AE bij gelijke data niet kopiëren en wel als deze anders zijn [/FONT]

 

[Cordo]

Sub Inboekingen_kopieren()
   
    Const FirstRow = 5
    Dim rij As Long
    Dim n As Long
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim OKToCopy As String
    








    Set src = Sheets("Jaar 2022")


    Application.ScreenUpdating = False
   
    For n = FirstRow To src.Cells(Rows.Count, "AE").End(xlUp).Row
        OKToCopy = "N"
        Set trg = Nothing
        If src.Cells(n, "AE").Value <> "" Then
           If n = FirstRow Or _
            src.Cells(n, "B").Value <> src.Cells(n - 1, "B").Value Or _
            src.Cells(n, "E").Value <> src.Cells(n - 1, "E").Value Or _
            src.Cells(n, "H").Value <> src.Cells(n - 1, "H").Value Or _
            src.Cells(n, "AD").Value <> src.Cells(n - 1, "AD").Value Then
            
            
    OKToCopy = "Y"
Else
    OKToCopy = "N"
End If
           
           If OKToCopy = "Y" Then
                    On Error Resume Next
                    Set trg = Worksheets(src.Cells(n, "AE").Value & " 22")
                    If Err <> 0 Then
                        Err.Clear
                        Set trg = ActiveWorkbook.Sheets.Add(After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count))
                        trg.Name = src.Cells(n, "AE").Value & " 22"
                        With src
                            .Range(.Cells(1, "A"), .Cells(4, "AZ")).Copy
                        End With
                        trg.Cells(1, "A").PasteSpecial
                    End If
                    rij = trg.Cells(Rows.Count, "AE").End(xlUp).Row + 1
                    With src
                        .Range(.Cells(n, "A"), .Cells(n, "AZ")).Copy
                    End With
                    trg.Cells(rij, "A").PasteSpecial
            End If
        End If
    Next n
    On Error GoTo 0
   
    Application.ScreenUpdating = True
   
End Sub

dit is het geworden mocht iemand dit willen weten.

er moet alleen nog gekeken worden naar de controle op dubbele op alle reeds gemaakte data op de sheets