VBA - viele CSV Dateien in ein Excel sheet

Hallo an alle,
ich bin ganz neu hier und bin auf diese Seite gestoßen bei der Recherche nach Lösungen.

Habe schon:
Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen

und

Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen Teil 2

versucht zu verwenden und zu verstehen, um es auf mein Problem anzuwenden, es hat aber leider nicht funktioniert.

Folgendes Makro bräuchte ich:
- ich habe viele csv Dateien mit jeweils 2 Spalten und sehr vielen Zellen
- ich möchte alle csv Dateien einlesen und dann in einer Zusammenfassung (!) nebeneinander (!!) stehen haben.
- Die Dateien sind im amerikanischen Stil gespeichert (Kommas sind Punkte) und die zwei Spalten sind durch Komma getrennt

In dem ersten Skript, dass ich gefunden hatte, wurde halt alles untereinander geschrieben, das ist unglücklich, da ich es nebeneinander brauche. Und bei dem zweiten Skript fehlt mir leider jegliche Informatik Kenntnis

Hoffe, ich habe die Lösung für mein Problem nicht einfach nur übersehen.

Vielen Dank für eure Hilfe

Ralf

Please also mark the comments that contributed to the solution of the article

Content-Key: 302883

Url: https://administrator.de/contentid/302883

Printed on: April 23, 2024 at 09:04 o'clock

2 Comments

Latest comment

Hallo,

ich habe mal den Code aus:
Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen Teil 2

ein wenig angepasst, nicht schön aber sollte funktionieren:

Sub ImportiereCSVDateien()
    Const CSVPFAD = "E:\csv-dateien"  
    Dim wbTarget As Workbook, wbSource As Workbook, ws As Worksheet, ts As Worksheet
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set wbTarget = ActiveWorkbook
    Application.DisplayAlerts = False
    'Lösche alle Worksheets bevor wir alle neu anlegen  
    While wbTarget.Worksheets.Count > 1
            wbTarget.Worksheets(1).Delete
    Wend
    wbTarget.Worksheets(1).Name = "Zusammenfassung"  
    wbTarget.Worksheets(1).Range("A:ZZ").Clear  
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(Right(f.Name, 3)) = "csv" Then  
            Workbooks.OpenText Filename:=f.Path
            Set wbSource = ActiveWorkbook
            On Error Resume Next
            Set ws = wbTarget.Worksheets(f.Name)
            If Err <> 0 Then
                Set ws = wbTarget.Worksheets.Add
                ws.Name = f.Name
                ws.Range("A:ZZ").Clear  
            End If
            
            wbSource.Worksheets(1).Range("A:A").Selection.Replace What:=",", Replacement:=";", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
            wbSource.Worksheets(1).Range("A:A").Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False  
            
            wbSource.Worksheets(1).Range("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Semicolon:=True, TrailingMinusNumbers:=True  
            wbSource.Worksheets(1).Range("A:ZZ").Copy Destination:=ws.Range("A1")  
            wbSource.Close False
        End If
    Next
    Set ts = wbTarget.Worksheets("Zusammenfassung")  
    Dim curCell As Range
    Set curCell = ts.Range("A1")  
    For i = 1 To wbTarget.Worksheets.Count - 1
        maxRow = wbTarget.Worksheets(i).Range("A1").End(xlDown).Row  
        maxCol = wbTarget.Worksheets(i).Range("A1").End(xlToRight).Column  
        wbTarget.Worksheets(i).Range(wbTarget.Worksheets(i).Cells(1, 1), wbTarget.Worksheets(i).Cells(maxRow, maxCol)).Copy Destination:=curCell
        Zelle = Chr(65 + 2 * i) & 1
        Set curCell = ts.Range(Zelle)
    Next
    Application.DisplayAlerts = True
    Set fso = Nothing
End Sub