Verwijderen van identieke rijen

[raflauryss]

Hallo

Ik heb volgende code gevonden een identieke rij te verwijden:

Sub DeleteDups()
Dim x As Long
Dim LastRow As Long

LastRow = Range("A65536").End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x
End Sub


Nu zou ik de macro zodanig willen aanpassen dat deze de originele rij verwijdert en vervangt door de dubbele rij.

Iemand een idee hoe deze macro dan aapgepast moet worden ?

 

[snb]

Jouw macro gaat niet over identieke rijen maar rijen met in kolom A dezelfde gegevens.

Als het over rijen gaat: (met gegevens in kolom A tm F ; pas dit zonodig aan)

Sub ontdubbel()
  Sheets.Add
  Sheets(2).[A1].CurrentRegion.AdvancedFilter xlFilterCopy, Sheets(2).[A1:F1], Sheets(1).[A1], True
End Sub

 

[raflauryss]

Dank je wel.

Eingenlijk moet de macro binnen dezelfde sheet zoeken op identieke gegevens in kolom A. Indien hij er dan vindt, moet deze macro de originele rij verwijderen en vervangen door de dubbele rij.

Nu verwijdert hij de dubbele rij en laat hij de originele staan.
Het is wss maar een kleine aanpassing.