Macro der kopierer data til det første tomme felt i en række

Hej,

Jeg er ved at lave et macro der skal løbe nogle rækker igennem og tjekke om der er dubletter.
Hvis der er dubletter skal den tage data fra kolonne 19+20 og kopierer dem til den aktive række - efterfølgende slette den næste.

eksempel
kundenr        navn        produkt1    pris1  produkt2 pris2   
12              peter        kniv        10
222            palle        hus          50 
222            palle        skorsten    200
56              anders      gaffel        50

Skulle blive til:

kundenr        navn        produkt    pris  produkt  pris
12              peter        kniv        10
222            palle        hus          50    skorsten 200
56              anders      gaffel      50

Jeg har dog problemer med at få kopi funktionen til at virke
samt den palcerer teksten forkeret steder...
Er i tvivl om syntaksen er korrekt?

Håber nogen kan hjælpe


Sub FindDubletter()

Dim iListCount As Integer
Dim iCtr As Integer
Dim ipolCount1 As Integer
Dim ipolCount2 As Integer
Dim CurrRow As Long

       

' Turn off screen updating to speed up macro.
Application.ScreenUpdating = True

' Get count of records to search through.
iListCount = Sheets("ark1").Range("a1:a300").Rows.Count
Sheets("ark1").Range("b2").Select
' Loop until end of records.
Do Until ActiveCell = ""
  ' Loop through records.
  For iCtr = 1 To iListCount
      ' Don't compare against yourself.
      ' To specify a different column, change 1 to the column number.
     
      If ActiveCell.Row <> Sheets("ark1").Cells(iCtr, 2).Row Then
        ' Do comparison of next record.
        If ActiveCell.Value = Sheets("ark1").Cells(iCtr, 2).Value Then
           
     

CurrRow = ActiveCell.Row
'find data i kolonne 19 og kopier det til første tomme celle i rækken
'find data i kolonne 20 og kopier det til første tomme celle i rækken
            Sheets("ark1").Cells(iCtr, 20).Copy Destination:=Cells(CurrRow, Columns.Count).End(xlToLeft).Offset(0, 1)
            Sheets("ark1").Cells(iCtr, 19).Copy Destination:=Cells(CurrRow, Columns.Count).End(xlToLeft).Offset(0, 1)
           
            ' Efter data er kopieret slettes rækken
            Sheets("ark1").Rows(iCtr).Delete xlShiftUp
                     
                ' Sheets("ark1").Cells(iCtr, 1).Delete xlShiftUp
              ' Increment counter to account for deleted row.
            '  ipolCount1 = ipolCount1 + 1
            '  ipolCount2 = ipolCount1 + 1
            '
              iCtr = iCtr + 1
        End If
      End If
  Next iCtr
  ' Go to next record.
  ActiveCell.Offset(1, 0).Select
Loop
Application.ScreenUpdating = True
MsgBox "Done!"
End Sub