|
Hi,
Option Explicit
Private Sub test()
Dim R&, C&, E1&, E2&, str$
Dim rng as range, Vals, V
With ActiveSheet
Set rng = .Range(.Cells(Rows.Count, 2).End(xlUp).Offset(0, -1), .Cells(1, Columns.Count).End(xlToLeft)) 'Tabelle
End With
Vals = rng.Value
E1 = UBound(Vals)
E2 = UBound(Vals, 2)
For R = 1 To E1
For C = 3 To E2 Step 5
V = Vals(R, C)
If Not IsError(V) Then
If V <> "" Then
If str = "" Then
str = V
Else
str = str & ", " & V 'Trennzeichen Komma und Leerzeichen
End If
End If
End If
Next
Vals(R, 1) = str 'zusammentragen in Spalte 1
Next
rng.Value = Vals
End Sub
Gruß
Till
|