Mehrere CSV importieren

Hallo zusammen,
ich habe im Ordner 'C:\Daten\' mehrere csv-Dateien, in denen sich jeweils im Bereich A1:T6 Daten befinden. Die Daten aus den csv-Dateien möchte ich nun untereinander in ein leeres Tabellenblatt kopieren. Das Kopieren der Daten soll in der gleichen Reihenfolge geschehen, wie die csv-Dateien im Ordner 'C:\Daten\' liegen. Die Namen der csv-Dateien variieren, so das vor dem Importieren der Ordner ausgelesen werden muss, ebenso variiert die Anzahl der csv-Dateien im Bereich 1-20.
Nochmal in der Kurzfassung:
1. Auslesen der Namen und Anzahl der csv-Dateien im Ordner 'C:\Daten\'
2. Kopieren des Bereichs A1:T6 der ersten csv-Datei und Einfügen in Tabelle1(A1:T6)
3. Wenn die Anzahl der csv-Dateien grösser ist als die bereits importieren, weiter
4. Kopieren des Bereichs A1:T6 der nächsten csv-Datei und Einfügen in Tabelle1(A7:T12)
5. Zurück zu 3. (Nächster Bereich zum Einfügen: A13:T18, A19:T24, usw..)
Vielen vielen Dank im Voraus & beste Grüsse
Henner
PS: Sollte das Uploaden einer Bsp.-CSV helfen hole ich das gerne nach!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Henner,
hier ein entsprechendes Makro.
Die Einstellungen sind so, dass die Trennzeichen und Zahlen/Datumsformate gemäß den lokalen Betriebsystem-/Excel-Einstellungen interpretiert werden.
Also Deutsch z.B.
Datum: TT.MM.YYYY
Dezimalzeichen: ,
1000er-Zeichen: .
Feldtrennzeichen: ;
Falls in der CSV-Datei andere Einstellungen verwendet sind, dann muss man am Parameter Format oder auch Local drehen.
Gruß
Franz

Sub CSV_Importieren()
Dim wksZiel As Worksheet, lngZeile_Z As Long
Dim wkbCSV As Workbook
Dim strPfad As String, strDatei As String
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Ordner mit CSV-Dateien auswählen"
.InitialFileName = "C:\Daten"
If .Show = -1 Then
strPfad = .SelectedItems(1)
Else
GoTo Beenden
End If
End With
Set wksZiel = ActiveWorkbook.Worksheets(1)
strPfad = strPfad & Application.PathSeparator
'CSV-Dateien suchen
strDatei = Dir(strPfad & "*.csv")
lngZeile_Z = 1 '1. Einfügezeile
Application.ScreenUpdating = False
Do Until strDatei = ""
Set wkbCSV = Application.Workbooks.Open(Filename:=strPfad & strDatei, _
ReadOnly:=True, Local:=True)
'    Set wkbCSV = Application.Workbooks.Open(Filename:=strPfad & strDatei, _
Format:=1, Origin:=xlWindows, ReadOnly:=True, Local:=True)
'Parameter Format:  1 Tabstopps _
2 Kommas _
3 Leerzeichen _
4 Semikolons
'Daten kopieren
wkbCSV.Worksheets(1).Range("A1:T6").Copy wksZiel.Cells(lngZeile_Z, 1)
'Spalten mit Infos zum Sortieren anfügen
With wksZiel
'Dateiname rechts neben den Daten in Spalte U einfügen
.Range(.Cells(lngZeile_Z, 21), .Cells(lngZeile_Z + 5, 21)).Value = strDatei
'fortlaufende Nr. für die 6 Zeilen in Spalte V einfügen
With .Range(.Cells(lngZeile_Z, 22), .Cells(lngZeile_Z + 5, 22))
.FormulaR1C1 = "=ROW()- " & lngZeile_Z & " + 1"
.Calculate
.Value = .Value
End With
End With
'Nächste Einfügezeile
lngZeile_Z = lngZeile_Z + 6
'CSV-Datei wieder schliessen
wkbCSV.Close savechanges:=False
Set wkbCSV = Nothing
strDatei = Dir
Loop
Application.ScreenUpdating = True
Beenden:
End Sub

'With Application.FileDialog(msoFileDialogFolderPicker) ' .Title = "Bitte Ordner mit CSV-Dateien auswählen" '.InitialFileName = "C:\Daten" 'If .Show = -1 Then 'strPfad = .SelectedItems(1) 'Else 'GoTo Beenden 'End If 'End With Set strPfad = "C:\Daten\" Set wksZiel = ActiveWorkbook.Worksheets(1)

Sub CSV_Importieren() Dim wksZiel As Worksheet, lngZeile_Z As Long Dim wkbCSV As Workbook Dim strPfad As String, strDatei As String strPfad = "C:\Daten\" ' strPfad = "C:\Users\Public\Abteilung D\" Set wksZiel = ActiveWorkbook.Worksheets(1) 'CSV-Dateien zählen strDatei = Dir(strPfad & "*.csv") Do Until strDatei = "" lngZeile_Z = lngZeile_Z + 1 strDatei = Dir Loop If lngZeile_Z > 20 Then If MsgBox("Es sind " & lngZeile_Z & " CSV-Dateien im Verzeichnis." & vbLf _ & "Dateien importieren?", _ vbQuestion + vbOKCancel, "Import CSV-Dateien") = vbCancel Then GoTo Beenden End If 'CSV-Dateien importiereb strDatei = Dir(strPfad & "*.csv") lngZeile_Z = 1 '1. Einfügezeile Application.ScreenUpdating = False Do Until strDatei = "" Set wkbCSV = Application.Workbooks.Open(Filename:=strPfad & strDatei, _ ReadOnly:=True, Local:=True) ' Set wkbCSV = Application.Workbooks.Open(Filename:=strPfad & strDatei, _ Format:=1, Origin:=xlWindows, ReadOnly:=True, Local:=True) 'Parameter Format: 1 Tabstopps _ 2 Kommas _ 3 Leerzeichen _ 4 Semikolons 'Daten kopieren wkbCSV.Worksheets(1).Range("A1:T6").Copy wksZiel.Cells(lngZeile_Z, 1) 'Spalten mit Infos zum Sortieren anfügen With wksZiel 'Dateiname rechts neben den Daten in Spalte U einfügen .Range(.Cells(lngZeile_Z, 21), .Cells(lngZeile_Z + 5, 21)).Value = strDatei 'fortlaufende Nr. für die 6 Zeilen in Spalte V einfügen With .Range(.Cells(lngZeile_Z, 22), .Cells(lngZeile_Z + 5, 22)) .FormulaR1C1 = "=ROW()- " & lngZeile_Z & " + 1" .Calculate .Value = .Value End With End With 'Nächste Einfügezeile lngZeile_Z = lngZeile_Z + 6 'CSV-Datei wieder schliessen wkbCSV.Close savechanges:=False Set wkbCSV = Nothing strDatei = Dir Loop Application.ScreenUpdating = True Beenden: End Sub

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

54 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Mehrere CSV importieren

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

54 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread