Ich bin auf der Suche nach einem Makro, dass mir alle
csv-Dateien, die sich in einem vorgegebenen Ordner befinden,
automatisch in eine normale Excel-Tabelle untereinander
importiert. Diese csv-Dateien sind alle gleich aufgebaut.
Hallo Teltorion,
alt+F11, Einfügen—Modul, Code reinkopieren, ggfs. im Code Anpassungen vornehmen, Editor schließen.
Alt+F8, Makro „CSVEinlesen“ ausführen lassen.
Die Codezeile
'Call Loesch
ist durcj had Hochkomma noch inaktiv. Das noch folgenden Grund, überprüfe alle geöffneten csv-Mappen, ob da auch in Spalte A unten die allerunterste gefüllte Zelle des ganzen Blattes ist.
Denn der Code prüft nur Spalte A ab.
Sag also Bescheid, wenn unterhalb von Ax noch in anderen Spalten Werten stehen, dann muß man den Code umschreiben.
Genauso sag bescheid wenn auch die Mappennamenn mit erfasst werden sollen in der Zusammenfassung und wohin sie geschrieben werden sollen.
Wenn alles klar ist, mach das Hochkomma weg.
Gruß
Reinhard
Option Explicit
Sub CSVEinlesen()
Dim fs As FileSearch, ZeiQ As Long, ZeiZ As Long, F As Integer
Dim wksQ As Worksheet, wksZ As Worksheet
Set wksZ = ThisWorkbook.Worksheets("Tabelle1") 'Anpassen
Set fs = Application.FileSearch
On Error GoTo hell
Call Loesch
Application.ScreenUpdating = False
With fs
.LookIn = "C:\test" 'Anpassen
.SearchSubFolders = False 'Anpassen
.Filename = "\*.csv"
If .Execute() \> 0 Then
For F = 1 To .FoundFiles.Count
ZeiZ = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
If ZeiZ = 2 Then ZeiZ = 1
Workbooks.Open Filename:=.FoundFiles(F), Format:=4 '4=Semikolon 'Anpassen
ZeiQ = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
ActiveWorkbook.Worksheets(1).Rows("1:" & ZeiQ).Copy Destination:=wksZ.Cells(ZeiZ, 1)
Next F
Else
MsgBox "There were no CSV files found in c:\test."
End If
'Call Loesch
End With
hell:
If Err.Number 0 Then
MsgBox ActiveWorkbook.Name & vbCr & Err.Number & vbCr & Err.Description
End If
Application.ScreenUpdating = True
End Sub
Sub Loesch()
Dim wkb As Workbook
Application.ScreenUpdating = False
For Each wkb In Workbooks
If wkb.Name Like "\*.csv" Then
wkb.Close savechanges:=False
End If
Next wkb
Application.ScreenUpdating = True
End Sub
