VBA Hilfe | Liste aus mehreren Dateien
02.09.2017 12:55:17
Felix
ich stehe vor einem Problem, welches ich alleine aufgrund meiner nicht wirklich vorhandenen VBA Kenntnisse nicht bewätligen kann.
Vieleicht kann mir ja irgendwer dabei weiterhelfen oder mir einen Tipp geben.
Folgendes Problem:
Ich habe einen Ordner mit mehreren Excel Dateien. Jede dieser Excel Dateien ist ein immer gleich aufgebautes Formular. Aus diesen Formularen möchte ich gerne die Zellen (C;3) und (E; 51) auslesen und in eine eigene Liste eintragen lassen.
Wie mache ich das am besten? Ich habe hier schon ein bisschen gestöbert und einiges and Code gefunden, was meinem Problem ähnlich ist, aber doch nicht ganz das gleiche.
Daraus habe ich mal folgendes Gebilde gebaut:
Sub Datenzusammenfassung()
Dim dat
Dim ordner
Dim datein
Dim fso
Dim arr(65536, 3)
Dim L As Long
Dim Z As Long
Dim WB
Dim dsplalert As Boolean
Dim cal
Dim scrup As Boolean
Dim ev As Boolean
With Application
dsplalert = .DisplayAlerts
cal = .Calculation
scrup = .ScreenUpdating
ev = .EnableEvents
.DisplayAlerts = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
arr(L, 0) = "Testbereich1"
arr(L, 1) = "Testbereich2"
arr(L, 2) = "Testbereich3"
L = L + 1
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
.Title = "Verzeichniswahl"
.InitialFileName = "C:\"
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
Set fso = CreateObject("Scripting.filesystemobject")
Set datein = fso.getfolder(ordner)
For Each WB In datein.Files
If WB.Name Like "*.xlsx" Then
Workbooks.Open WB
For Z = 3 To Sheets(1).Range("a65536").End(xlUp).Row
arr(L, 0) = Sheets(1).Cells(Z, 3).Text
Next
For k = 51 To Sheets(1).Range("a65536").End(xlUp).Row
arr(L, 1) = Sheets(1).Cells(k, 5).Text
L = L + 1
Next
Workbooks(WB.Name).Close False
End If
Next
Range("A:C") = arr
raus:
With Application
.DisplayAlerts = dsplalert
.Calculation = cal
.ScreenUpdating = scrup
.EnableEvents = ev
End With
End Sub
Allerdings werden lediglich die Werte aus der jeweiligen Zelle (E;51) in die Tabelle eingetragen und nicht die aus (C;3).
Wie müsste ich meinen Code anpassen, dass ich mein Problem lösen lässt? und kann ich es eventuell noch so einrichten, dass der Dateiname des jeweiligen Formulars immer in die erste Spalte eingefüllt wird?
Vielen Dank für alle Vorschläge schon mal im Voraus.
Beste Grüße,
Felix