Hallo allemaal,
Heb regelmatig op dit forum gekeken en eigenlijk nooit helemaal het antwoord gevonden. Er staat ergens op dit forum een marco voor ontdubbelen en verplaatsen, maar deze werkt niet zoals ik wil. Onderstaande macro haalt netjes alle dubbelen weg, maar ik zou graag dat de regels niet helemaal uit het bestand verdwijnen maar dat deze naar bv blad 2 worden verplaatst. Heb ook een voorbeeld toegevoegd met wat de bedoeling is. Als iemand mij kan helpen, zou dat heel fijn zijn en mij veel tijd besparen. Alvast bedankt
Sub DubbleDelete()
'Dim Rij, Kolom, StartRij, EindRij, TempValue
Application.Calculation = xlManual
On Error Resume Next
Rij = ActiveCell.Row
Kolom = ActiveCell.Column
Do While Cells(Rij, Kolom) <> ""
If Trim(Cells(Rij, Kolom).Value) = Trim(Cells(Rij + 1, Kolom)) Then
Rows(Rij).Select
Selection.Delete Shift:=xlUp
Else
Rij = Rij + 1
End If
Loop
Cells(1, kolom).Select
Application.Calculation = xlAutomatic
End Sub
Heb regelmatig op dit forum gekeken en eigenlijk nooit helemaal het antwoord gevonden. Er staat ergens op dit forum een marco voor ontdubbelen en verplaatsen, maar deze werkt niet zoals ik wil. Onderstaande macro haalt netjes alle dubbelen weg, maar ik zou graag dat de regels niet helemaal uit het bestand verdwijnen maar dat deze naar bv blad 2 worden verplaatst. Heb ook een voorbeeld toegevoegd met wat de bedoeling is. Als iemand mij kan helpen, zou dat heel fijn zijn en mij veel tijd besparen. Alvast bedankt
Sub DubbleDelete()
'Dim Rij, Kolom, StartRij, EindRij, TempValue
Application.Calculation = xlManual
On Error Resume Next
Rij = ActiveCell.Row
Kolom = ActiveCell.Column
Do While Cells(Rij, Kolom) <> ""
If Trim(Cells(Rij, Kolom).Value) = Trim(Cells(Rij + 1, Kolom)) Then
Rows(Rij).Select
Selection.Delete Shift:=xlUp
Else
Rij = Rij + 1
End If
Loop
Cells(1, kolom).Select
Application.Calculation = xlAutomatic
End Sub