Datenpaare kenntlich machen

Private Sub CommandButton65_Click()
Application.ScreenUpdating = False
Workbooks.Add
Range(Cells(1, 1), Cells _
(ListBox7.ListCount, 2)).Value = ListBox7.List
Range("A1").Sort Key1:=Range("B1"), _
Order1:=xlDescending, key2:=Range("A1"), _
order2:=xlDescending
ListBox7.List = Range("A1").CurrentRegion.Value
ActiveWorkbook.Close savechanges:=False
End Sub

Sub UebertragenC()
Dim lRow As Long
Dim i As Long
i = Worksheets("Daten").Cells(Rows.Count, 12).End(xlUp).Row
With Worksheets("CAuswertung")
lRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
Worksheets("Daten").Range("L1:L" & i).Copy .Cells(lRow, 1)
End With
Application.CutCopyMode = False
End Sub

Sub HaeufigkeitUebertragenC()
Dim bereich As Range
Dim i As Long
i = Worksheets("CAuswertung").Cells(Rows.Count, 1).End(xlUp).Row
For Each bereich In Sheets("CAuswertung").Range("A1:A" & i)
bereich.Offset(0, 1) = _
Application.WorksheetFunction.CountIf(Sheets("Daten").Range("L:L"), bereich)
Next bereich
End Sub

Sub SetFilterC()
Sheets("CAuswertung").Rows("1:1").Delete
Sheets("CAuswertung").Range("A1").CurrentRegion.AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:= _
Sheets("CAuswertung").Range("B1"), Unique:=True
Sheets("CAuswertung").Columns(1).EntireColumn.Delete
End Sub

Sub Koppeln()
Application.ScreenUpdating = False
Dim z As Long
z = 1
Do While Sheets("Daten").Cells(z, 1) ""
Sheets("Daten").Cells(z, 12) = Sheets("Daten").Cells(z, 1) & " // " & Sheets("Daten").Cells(z, 3)
z = z + 1
Loop
'Sheets("Daten").Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Dank an Euch.
Gruss Volker