Hejsa Forum,

Prøver det lige igen - syntes nu at jeg fulgte vejledningen

Hej

Tak

Ville lige informere om at løsningen ikke helt svarede til det jeg søgte efter.
Men jeg har fået stykket denne kode sammen - med min beskedne viden som nybegynder i vba.
Syntes dog at jeg ville dele den med jer herinde.
Den funker men kan sikkert forberes. :-) Og skulle der være en som keder sig så er du velkommen. :-)Kunne jo være andre som havde samme udfordring. :-)

Sub BeholdDubletter ()

    Dim lastRow As Integer, compRow As Integer, rowNo As Integer
    Dim wstOutput As Worksheet
    Dim copyrow As Long
    
    'Finder sidste række med data
    lastRow = ActiveWorkbook.Sheets("Beregning af Alder til Database").Range("A1").CurrentRegion.Rows.count
   
    'Looper igennem alle rækker

    For rowNo = 2 To lastRow

     Set wks = Worksheets("Data")

        'For each rowNo, looper igennem de sidste rækker

        For compRow = rowNo + 1 To lastRow

            'Checker om der er et match i kolonne A

            If Range("A" & compRow) = Range("A" & rowNo) Then
    
               'Hvis at der er et match i kolonne A, check den tilsvarende værdi i kolonne B

               If Range("B" & compRow) = Range("B" & rowNo) Then

                    'Hvis at der er et match i kolonne A og B, check den tilsvarende værdi i kolonne C

                    If Range("C" & compRow) = Range("C" & rowNo) Then
                        
                        'Dublikater fundet på tværs af de 3 kolonner. Markeres med gult
                        'Range("A" & compRow & ":D" & compRow).Interior.Color = vbYellow eller
                        'Dublikater fundet på tværs af de 3 kolonner. Kopier række A til D og placer dem i ark "Data
                        Range("A" & compRow & ":D" & compRow).Select
                        copyrow = wks.Cells(Rows.count, "A").End(xlUp).row + 1
                      Range("A" & compRow & ":D" & compRow).Copy _
                     Destination:=wks.Range("A" & copyrow & ":D" & copyrow)

                    End If
               End If
            End If
        Next compRow
    Next rowNo
End sub