Copie to

[brankscaffold]

I got this one off the net, but I can't get it to work quite right.

now only 2 lines are copied and always the same

Sub rowcopy()
Const FirstRow = 2
Dim rij As Long
Dim n As Long
Dim src As Worksheet
Dim trg As Worksheet
Dim SrcRow As Long
Dim lastRow As Long
                        Set src = Sheets("Ridon 22")
                        Set trg = Sheets("Asindo 22")
                                                        Application.ScreenUpdating = False

                        rij = trg.[A65536].End(xlUp).Row

For n = 5 To Blad1.[A65536].End(xlUp).Row
If Cells(n, "AE").Value = "Asindo" Then
Range(Cells(n, "A"), Cells(n, "AZ")).Copy
trg.Cells(rij, "A").PasteSpecial

 

[brankscaffold]

I also found this one and it copies everything but here I need another If Cells(n, "AE").Value = "Asindo" Then

Sub SplitData()

    Const NameCol = "AE"
    Const HeaderRow = 4
    Const FirstRow = 5
Dim SrcSheet As Worksheet
Dim TrgSheet As Worksheet
Dim SrcRow As Long
Dim lastRow As Long
Dim TrgRow As Long
Dim Ridon As String
Dim Asindo As String
Dim DebitNaam As String

                        Set src = Sheets("Ridon 22")
                        Set trg = Sheets("Asindo 22")
Application.ScreenUpdating = False
                        Set SrcSheet = ActiveWorkbook.Worksheets("Ridon 22")
    
    lastRow = SrcSheet.Cells(SrcSheet.Rows.Count, NameCol).End(xlUp).Row
    For SrcRow = FirstRow To lastRow
        DebitNaam = SrcSheet.Cells(SrcRow, NameCol).Value = "Asindo"
                         
                         Set TrgSheet = Nothing
        On Error Resume Next
                        Set TrgSheet = Worksheets("Asindo 22")
        If Err.Number = 9 Then Exit Sub
        On Error GoTo 0
        TrgRow = TrgSheet.Cells(TrgSheet.Rows.Count, NameCol).End(xlUp).Row + 1
        
        If Application.CountIf(TrgSheet.Range("AE:AE"), SrcSheet.Cells(SrcRow, "AE").Value) > 0 Then
        ' [COLOR="#B22222"]And _

     '   TrgSheet.Range("AE:AE").Find(SrcSheet.Cells(SrcRow, "AE").Value, , xlValues).Offset(, -1).Value = SrcSheet.Cells(SrcRow, "AC").Value
        '[/COLOR]Then
      ''      MsgBox "Duplicate Detected for " & SrcSheet.Cells(SrcRow, "B").Value
        Else
            SrcSheet.Rows(SrcRow).Copy Destination:=TrgSheet.Rows(TrgRow)
        End If
    Next SrcRow
    Application.ScreenUpdating = True
End Sub

 

[brankscaffold]

can any body help pls.

 

[Alex Blakenburg]

I am not 100% clear on what you are trying to do, your first lot of code in incomplete and from the 2nd I am unclear on the criteria.

The main change in the below is adding this:
rij = rij + 1 ' Added this line
give that a try.

There are faster ways of doing this but lets start with that and see if it does what you are trying to do.

Sub rowcopy_OPv01()
    Const FirstRow = 2
    Dim rij As Long
    Dim n As Long
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim SrcRow As Long
    Dim lastRow As Long
    Set src = Sheets("Ridon 22")
    Set trg = Sheets("Asindo 22")
    Application.ScreenUpdating = False
    
    rij = trg.[A65536].End(xlUp).Row
    
    For n = 5 To Blad1.[A65536].End(xlUp).Row
        If Cells(n, "AE").Value = "Asindo" Then
            rij = rij + 1                               ' Added this line
            Range(Cells(n, "A"), Cells(n, "AZ")).Copy
            trg.Cells(rij, "A").PasteSpecial
        End If                                          ' Assumed - Not in code provided
    Next n                                              ' Assumed - Not in code provided
End Sub

 

[brankscaffold]

out of 5 he now only takes 2 top ones

he must copy all rows named asindo to Sheet asindo and piet to sheet piet , empty must not go anywhere
(t

 

[Alex Blakenburg]

This is not the most efficient way of doing this if you have a of data but see if it now does what you are trying to do.

Sub rowcopy_mod()
    Const FirstRow = 5
    Dim rij As Long
    Dim n As Long
    Dim src As Worksheet
    Dim trg As Worksheet
    Dim SrcRow As Long              ' Not used
    Dim lastRow As Long             ' Not used
    Set src = Sheets("Ridon 22")
    Set trg = Sheets("Asindo 22")
    Application.ScreenUpdating = False
    
    For n = FirstRow To src.Cells(Rows.Count, "A").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)
            If Err = 0 Then
                rij = trg.Cells(Rows.Count, "A").End(xlUp).Row + 1
                src.Range(Cells(n, "A"), src.Cells(n, "AZ")).Copy
                trg.Cells(rij, "A").PasteSpecial
            Else
                Err.Clear
            End If
        End If
    Next n
    On Error GoTo 0
    
End Sub

 

[brankscaffold]

thank you for the effort you take for me I really appreciate it

he doesn't copy anything. shouldn't I have a Value = "AsIndo" somewhere/or enter it myself?

 

[Alex Blakenburg]

I take it you have multiple names in column AE and you want each to go to its each own sheet ?
If that is correct can you derive the sheet name from the value in column AE ?
eg if Asindo is sheet name Asindo 22, then what is the piet sheet name ?
If there is no relationship, we will need a list of names and their corresponding sheet names.

 

[brankscaffold]

I take it you have multiple names in column AE and you want each to go to its each own sheet ?

Yes that's right

If that is correct can you derive the sheet name from the value in column AE ?

it would be nice if a new sheet was also made for new names

eg if Asindo is sheet name Asindo 22, then what is the piet sheet name ?

22 is the year 2022.

If there is no relationship, we will need a list of names and their corresponding sheet names.

and the name (Asindo) etc.. comes from my staff list or from my customer file most are company names

now I have to transfer everything by hand every time which literally takes me hours
and I copy duplicate data too often

 

[Alex Blakenburg]

Do you need to copy formulas or just values ?

It looks like your first rows have merged cells, which most experienced Excel users avoid like the plague.

How about providing an XL2BB sample of your data, say the first 10 rows as shown in your images, to give me something to work with ?

XL2BB
MrExcel has a tool called “XL2BB” that lets you post samples of your data that will allow us to copy/paste it to our Excel spreadsheets, so we can work with the same copy of data that you are. Instructions on using this tool can be found here: XL2BB Add-in

Note that there is also a "Test Here” forum on this board. This is a place where you can test using this tool (or any other posting techniques that you want to test) before trying to use those tools in your actual posts.