Hallo,
teste:
Public Sub in_Spalten()
Dim loLetzte As Long, i As Long, varArray() As Variant
Application.ScreenUpdating = False
'Blattname anpassen
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, "V").End(xlUp).Row
For i = 4 To loLetzte
ReDim Preserve varArray(i - 4)
varArray(i - 4) = .Cells(i, "V").Text
Next i
.Cells(4, "W").Resize(loLetzte - 3) = WorksheetFunction.Transpose(varArray)
.Range(.Cells(4, "W"), .Cells(loLetzte, "W")).TextToColumns Destination:=Range("X4"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1), _
Array(2, 1)), TrailingMinusNumbers:=True
.Columns("W:W").Delete
End With
End Sub
Gruß Werner
|