28.05.2020, 13:20
Hi
fehlt doch nicht so viel.
Gruß Elex
fehlt doch nicht so viel.
Code:
Sub Liste()
Dim i As Long, Z, Pfad As String
On Error Resume Next
Application.ScreenUpdating = False
Pfad = Range("B2").Value
Workbooks.OpenText Filename:=Pfad, Origin:= _
xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
TrailingMinusNumbers:=True
i = Cells(Rows.Count, 1).End(xlUp).Row
Columns(1).Replace " ", "#"
Range("A2:A" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("B2:B" & i).FormulaR1C1 = "=IF(LEFT(RC[-1],1)=""#"",""# ""&RC[-1],RC[-1])"
Range("B2:B" & i).Copy
Range("A2:A" & i).PasteSpecial (xlPasteValues)
Columns(2).Delete
Columns(1).TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="#"
Range("C2:F" & i).Value = Range("C3:F" & i + 1).Value
Range("F2:F" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
For Each Z In Cells(1).CurrentRegion
Z.Value = Trim(Z.Value)
If Z.Column < 3 And Z.Row > 1 And Z.Value = "" Then Z.Value = Z.Offset(-1).Value
Next Z
Cells(1).CurrentRegion.Columns.AutoFit
Application.ScreenUpdating = True
End Sub