Function TrenneZelle(z As Range) As Boolean
Dim s1 As String, s2 As String, i As Long
i = InStr(z.Value, Chr(10))
If i = 0 Then TrenneZelle = False: Exit Function
s1 = Left(z.Value, i - 1)
s2 = Mid(z.Value, i + 1)
With z
.Value = s1
.EntireRow.AutoFit
.Offset(1, 0).Value = s2
End With
TrenneZelle = True
End Function
Sub Trennen()
Dim erg As Boolean
Dim zelle As Range
Set zelle = ActiveCell 'hier: aktive zelle wird getrennt
Do
erg = TrenneZelle(zelle)
If erg = False Then Exit Do
Set zelle = zelle.Offset(1, 0)
Loop
End Sub
Die Datei https://www.herber.de/bbs/user/24482.xls wurde aus Datenschutzgründen gelöscht
ich habe den Code nochmals geändert, so dass die Zeilen eingefügt und nicht überschrieben werden.Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen