AW: Kann man machen
09.12.2015 16:41:44
Liliane
Hallo Christoph
vielen Dank für Dein Vorschlag. Leider funktioniert das einlesen nicht. Auch die Tabelle wird irgendwie zerschossen.
Bisher habe ich einige Makros die Funktionieren.
Hier ist der Code den ich durchlaufen lasse:
Sub B_1_NeuesBlatt_fuer_CSV_Import_Formatieren_zurueck_Hauptblatt()
' Neues Blatt Anlegen mit CSV Import Formatieren und zurueck zum Hauptblatt
Application.ScreenUpdating = False
strName = ActiveSheet.Name
Sheets.Add After:=Sheets(strName)
ActiveSheet.Name = strName & "CSV_Kontoauszug"
Dim Importdatei$, Verzeichnis$
Verzeichnis = "O:\Kontoauszuege"
On Error Resume Next
ChDir Verzeichnis
Importdatei = Application.GetOpenFilename("Exceldateien (*.csv), *.csv")
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Importdatei, _
Destination:=Range("A1"))
.TextFileSemicolonDelimiter = True
.Refresh BackgroundQuery:=False
' Blatt wird Nach Spalten Formatiert und nach Blatt Garagen gewechselt
Application.ScreenUpdating = False
Application.ScreenUpdating = False
Columns("A:A").ColumnWidth = 15.57
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft
Range("A2").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A3").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("A4").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("C:C").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("D:D").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Columns("G:G").Select
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
Columns("G:N").Select
Selection.Delete Shift:=xlToLeft
Columns("H:H").Select
Selection.Delete Shift:=xlToLeft
Columns("G:G").Select
Selection.NumberFormat = "_(* #,##0.00_);_(* (#,##0.00);_(* ""-""?_);_(@_)"
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Cells(65000, 1).End(xlUp).Offset(1, 0).Select
' C_Wechsel_von_Garagen_nach_GaragenCSV_Kontoauszug Makro
Sheets("Garagen").Select
' SortNR Makro
Application.ScreenUpdating = False
ActiveWindow.SmallScroll Down:=-12
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
ActiveWorkbook.Worksheets("Garagen").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Garagen").Sort.SortFields.Add Key:=Range("F7:F78") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Garagen").Sort
.SetRange Range("F6:T78")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("F6").Select
End With
End Sub
Vor End If fehlt mir halt noch dieses Suchen und EInfügen Makro wie in meiner ersten Post beschrieben.
Danke
Gruß
Liliane