Auzulesendes Dateiformat xlsx->csv

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