Sub CSV_Import2()
Dim ws As Worksheet
Dim i As Integer
Dim strFile As Variant
Set ws = ActiveWorkbook.Sheets("Zwischenspeicher")
ws.Columns.NumberFormat = "@"
strFile = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please select text file...", , True)
For i = 1 To UBound(strFile)
ws.UsedRange.Delete
With ws.QueryTables.Add(Connection:="TEXT;" & strFile(i), Destination:=ws.Range("A1"))
.PreserveFormatting = True
.TextFileParseType = xlDelimited
.TextFileOtherDelimiter = ";"
.TextFileDecimalSeparator = "."
.Refresh
End With
RemoveHeaderData
CopyFromZwischenspeicherSheetToEndergebnis
Next i
Worksheets("Zwischenspeicher").Range("A1:AZ100000").Clear
ActiveWorkbook.Save
End Sub
Sub RemoveHeaderData()
Dim index As Integer
Dim ws As Worksheet
Dim done As Boolean
Dim colCount As Long
index = 1
Set ws = ActiveWorkbook.Sheets("Zwischenspeicher")
Do While done = False
colCount = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
If colCount > 5 Then
done = True
Else
ws.Rows(1).EntireRow.Delete
End If
Loop
End Sub
Sub CopyFromZwischenspeicherSheetToEndergebnis()
Dim ws_t As Worksheet
Dim ws_e As Worksheet
Dim i As Long
Set ws_t = ActiveWorkbook.Sheets("Zwischenspeicher")
Set ws_e = ActiveWorkbook.Sheets("Endergebnis")
i = ws_e.UsedRange.Rows.Count
If i = 1 Then i = 0
ws_t.UsedRange.Copy
ws_e.Cells(i + 1, 1).PasteSpecial xlPasteValues
End Sub
Sub ArbeitsmappeSpeichern()
ActiveWorkbook.SaveAs (ThisWorkbook.Path & ".xlsx")
ActiveWorkbook.Close
End Sub