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