|
Habe noch etwas rumgespielt und das Trennen automatisiert
wie folgt sieht nun mein Code aus:
sub Exchange_Beispiel()
Dim cell As Range
Columns("B:C").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
For Each cell In Worksheets("Sheet1").UsedRange
cell.Value = Replace(cell.Value, "Beispiel", ";Name0;")
cell.Value = Replace(cell.Value, "Bei1spiel", ";Name1;")
cell.Value = Replace(cell.Value, "Bei2spiel", ";Name2;")
cell.Value = Replace(cell.Value, "Bei3spiel", ";Name3;")
cell.Value = Replace(cell.Value, "Bei4spiel", ";Name4;")
Next cell
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1))
Columns("A:A").Select
Selection.ClearContents
Columns("C:C").Select
Selection.ClearContents
Columns("B:B").Select
Selection.Cut
Columns("A:A").Select
ActiveSheet.Paste
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
End Sub
(sry für den hässlichen Code - Makro-recorder und so...)
danke euch
|