Moin zusammen,

ich habe hier ein Programm, das ich schon etwas angepasst habe, allerdings stoße ich hier auf ein problem da ich mit meinen Fähigkeiten nicht lösen kann.

Es wäre fantastisch, wenn Ihr mir etwas unter die Arme greifen könntet.

Funktion:

- Es ließt nacheinander alle .xlsx Dateien in einem Ordner aus kopiert die Werte in B12 und B13 und fügt Sie untereinander in eine Excel Liste ein.

Problem:

- Die Dateien die ich auslesen muss sind im .CSV Format

Herzlichen Dank für eure Hilfe!

Gruß Kevin

Sub Ordner_suchen()
Dim dat
Dim ordner
Dim datein
Dim fso
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Ein Array mit 65536 Zeilen und 3 Spalten.
'Dient zur sp?teren Aufnahme der Werte.
Dim arr(65536, 2)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Dim L As Long
Dim Z As Long
Dim WB
Dim dsplalert As Boolean
Dim cal
Dim scrup As Boolean
Dim ev As Boolean
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Zum Beschleunigen des Makros
With Application
    dsplalert = .DisplayAlerts
    cal = .Calculation
    scrup = .ScreenUpdating
    ev = .EnableEvents
    .DisplayAlerts = False              'Excelinterne Meldungen aus
    .Calculation = xlCalculationManual  'Automatische Berechnung aus
    .ScreenUpdating = False             'Bildschirm aktualisierung aus
    .EnableEvents = False               'Makrostarts aus
End With

'XXXXXXXXXXXXXXXXXXXXXXXXXXX
'?berschriften ins Array schreiben
arr(L, 0) = "Nr."
arr(L, 1) = "Druck [bar(g)]"
arr(L, 2) = "Temperatur [?C]"
L = L + 1
'XXXXXXXXXXXXXXXXXXXXXXXXXXX
'Dialog aufrufen
'Die innere IF-Then Konstruktion f?ngt "Abbrechen" in dem Dialog ab.
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
   .Title = "Such sch?n...."
   .InitialFileName = "C:\" 'oder was auch immer
nochmal:
If .Show = -1 Then
    ordner = .SelectedItems(1)
Else:
    If MsgBox("Ordner ausw?hlen vergessen." & vbCrLf & "Nochmal ?", vbYesNo) = vbYes Then
    GoTo nochmal
    Else:
        GoTo raus
    End If
End If
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Zugriff aus Dateisystem
Set fso = CreateObject("Scripting.filesystemobject")
Set datein = fso.getfolder(ordner)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Sucht jedes file in Ordner.
'i istdie Variable
For Each WB In datein.Files
    If WB.Name Like "*.xlsx" Then 'selbserkl?rend
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
        Workbooks.Open WB        'selbserkl?rend
        'Jetzt wird die eigentliche Arbeit gemacht.
        'z ist eine Variable ?ber Zeilen.
        'Sheets(1).Range("a65536").End(xlUp).Row ist die
        'Zeilennummer der letzten beschriebenen Zelle in SpalteA
        'von WB.sheets(1).
        For Z = 1 To Sheets(1).Range("a1").End(xlUp).Row '.Range("a1") ist die Anzahl der zeilen die beschriftet werden mit dem Ergebnis
                'arr(L, 0) = Sheets(1).Cells(Z, 1).Text
                '   schreibt den Wert aus cells(zeile=z,Spalte=1) ins Array an Position
                '   Zeile=2 und Spalte =1
                arr(L, 1) = Sheets(1).Cells(13, 2).Text 'Druck
                '   schreibt den Wert aus cells(zeile=z,Spalte=3) ins Array an Position
                '   Zeile=2 und Spalte =2
                arr(L, 2) = Sheets(1).Cells(12, 2).Text 'Temperatur
                '   schreibt den Wert aus cells(zeile=z,Spalte=5) ins Array an Position
                '   Zeile=2 und Spalte =3
                L = L + 1
        Next
        Workbooks(WB.Name).Close False
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXX
    End If
Next
Range("A:C") = arr 'Alle Werte auf einmal in die Tabelle ?bertragen
raus:
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Die Eingangs gemachten Einstellungen R?ckg?ngig machen
With Application
     .DisplayAlerts = dsplalert
     .Calculation = cal
     .ScreenUpdating = scrup
     .EnableEvents = ev
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
End Sub