Would this be something you could use?
Sub JasperDz()
Dim i As Long, x As String, ws As Worksheet
With Application
.DisplayAlerts = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set ws = ActiveSheet
ws.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "New Sheet"
x = ""
For i = 2 To Range("A" & Rows.Count).End(3).row
Cells(i, "A").TextToColumns Cells(i, "A"), xlDelimited, xlDoubleQuote, False, True, False, False, False, True, ":"
Rows(i).Copy
Range("A" & Rows.Count).End(3)(2).PasteSpecial Transpose:=True
Next i
ActiveSheet.UsedRange.Offset(, 1).Delete
Range("A2:A" & Range("A" & Rows.Count).End(3).row).Sort Key1:=Range("A2"), Order1:=xlAscending
For i = Range("A" & Rows.Count).End(3).row To 2 Step -1
If Range("A" & i - 1) = Range("A" & i) Then
Range("A" & i) = ""
End If
Next
Range("A2:A" & Range("A" & Rows.Count).End(3).row).SpecialCells(4).Delete xlUp
For i = 2 To Range("A" & Rows.Count).End(3).row
x = x & ":" & Cells(i, "A")
x = x
Next i
Range("A2") = Right(x, Len(x) - 1)
Range("A3:A" & Range("A" & Rows.Count).End(3).row).Delete
Rows(2).Copy ws.Range("A" & Rows.Count).End(3)(2)
Sheets("New Sheet").Delete
With Application
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Bookmarks