Option Explicit
Private Sub Ausfüllen()
Dim Zeile As Long, R As Long
Dim rng As Range, Arr, lastInd&
'set
Zeile = 1 ' beginnt bei Zeile 15
With ActiveSheet
Set rng = .Range(.Cells(Zeile, 1), .Cells(.Rows.Count, 2).End(xlUp))
End With
Arr = rng.Value
'daten eintragen
For R = 1 To UBound(Arr)
arr(r,2)="*" & arr(r,2) & "*"
If Arr(R, 1) <> "" Then
lastInd = Arr(R, 1)
End If
If Arr(R, 2) <> "" Then
Arr(R, 1) = lastInd
End If
Next
'array in die Tabelle übertragen
rng.Value = Arr
rng.Columns(2).Copy rng.Columns(8)
End Sub
Das könntest du einfach so machen, wird aber dann in beiden Spalten in Sternchen stehen.
Gruß
Till
|