Slå dubletter sammen på en linje

En makro kan klare dette automatisk.

Yes. Det er jeg med på. Men jeg mangler en makro der kan gøre det.

Prøv med denne lille makro:

Sub MergeDublicates()
LastRow = ActiveSheet.UsedRange.Rows.Count
For x = LastRow To 2 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
Cells(x - 1, 2) = Cells(x - 1, 2) & "/" & Cells(x, 2)
Cells(x, 1).EntireRow.Delete
End If
Next
End Sub

Jeg glemte at skrive, at det er en forudsætning at databasen er sorteret.

Og uden sortering kunne makroen se sådan ud:

Sub MergeDublicates()
LastRow = ActiveSheet.UsedRange.Rows.Count
Range("A2:B2").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A2:A" & LastRow) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A2:B" & LastRow)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
For x = LastRow To 2 Step -1
If Cells(x, 1) = Cells(x - 1, 1) Then
Cells(x - 1, 2) = Cells(x - 1, 2) & "/" & Cells(x, 2)
Rows(x).Delete
End If
Next
End Sub

Det var da fantastisk. Script 1 kørte smurt, og løser mit problem.! Script2 fik jeg en runtime fejl 9 på (Subscript out of range) - blot en note.

Hvis kolonne 3 er virksomhed, kan denne så komme med i sorteringen. (kun hvis du har et quickfix til dette :-)) ellers er det lige meget.

Tusind tak for hjælpen.!

Du må gerne smide et svar. Tak.

Hvis du vil have kolonne 3 med i sorteringen skal du blot ændre linie 3 fra
Range("A2:B2").Select
til
Range("A2:C2").Select

Jeg kan ikke lige se hvorfor du får runtime fejl 9.

Det spiller. Eneste problem i script2 var navngivningen på fanen. Da jeg rettede dette, virkede det også.

Det er simpelthen godt lavet af dig :-) Jeg er imponeret.