Hallo Andre,
möchte noch etwas Hintergrundinformationen geben.
Es gibt eine Datei, nennen wir Sie
Zusammenfassung.xls wo die herausgelesenen Punkte aus den div. anderen Exceldateien (nennen wir Sie Datei1.xls + Datei2.xls usw. - die Anzahl kann unendlich sein) reinkopiert werden sollen. Das klappt auch mit meinem bisherigen Code (siehe unten) auch einwandfrei.
Nun haben wir das Problem, dass es aktuell zwei unterschiedliche Versionen der Datei1 und Datei2 gibt. Grundsätzlich werden in diesen Dateien die gleichen Daten aufgeführt - jedoch je nach Version in unterschiedlichen Zellen. Unterscheidbar sind die Versionen durch einen Eintrag in einer Zelle, z.Bsp. in der
Datei1 steht in der Zelle B106=XY. In der
Datei2.xls ist diese Zelle leer.
Somit soll das erste Makro prüfen, ob in der Zelle B106 der
Datei1.xls etwas hinterlegt ist z.Bsp. der text "XY". Wenn ja --> Rufe Makro1 auf, welches
dann die jeweiligen Daten in dieser Datei anhand des Makro1 herauslist und in die Datei
Zusammenfassung.xls schreibt. Wenn die Prüfung ergibt, dass B106 leer ist, dann führe Makro2 durch und lese die Daten aus und speicher Sie in die Datei
Zusammenfassung.xls. Und dies für jede einzelne Datei die in diesem Ordner gespeichert ist.
Code:
Option Explicit
Sub QAFsauswerten()
Dim strDateiname As String
Dim strPfad As String
Dim lngZeile As Long
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "c:\" '"C:\Users\theodor\Desktop\testquaf"
.Title = "Ordner"
.ButtonName = "your Choice :)"
.InitialView = msoFileDialogViewList
If .Show = -1 Then
strPfad = .SelectedItems(1)
If Right(strPfad, 1) <> "\" Then strPfad = strPfad & "\"
Else
strPfad = ""
End If
End With
If strPfad = "" Then
Exit Sub
Else
'Den 1. Dateinamen holen
strDateiname = Dir(strPfad & "*.xls")
'Startzeile festlegen
lngZeile = 2
'Solange ein Dateiname gelesen wird
Do While Not strDateiname = ""
'Datei verarbeiten
Call TabVerarb(strPfad & strDateiname, lngZeile)
'nächsten Dateinamen holen
strDateiname = Dir()
'Zeilenzähler erhöhen
lngZeile = lngZeile + 1
Loop
End If
End Sub
Public Sub TabVerarb(strPfad As String, lngZeile As Long)
Dim strMeSH As String
Dim strDatei As String
Dim strSH As String
'Dateinamen extrahieren
strDatei = Split(strPfad, "\")(UBound(Split(strPfad, "\")))
'Eigenen Namen merken
strMeSH = ActiveWorkbook.Name
'Datei öffnen
Workbooks.Open Filename:=strPfad
With Workbooks(strMeSH)
'Dateinamen und auszuwertenden Zellen übertragen
.Sheets("Tabelle1").Cells(lngZeile, 1) = strDatei
.Sheets("Tabelle1").Cells(lngZeile, 2) = Workbooks(strDatei).Sheets("Summary").Range("G16").Value
.Sheets("Tabelle1").Cells(lngZeile, 3) = Workbooks(strDatei).Sheets("Summary").Range("K8").Value
.Sheets("Tabelle1").Cells(lngZeile, 4) = Workbooks(strDatei).Sheets("Summary").Range("D27").Value
.Sheets("Tabelle1").Cells(lngZeile, 5) = Workbooks(strDatei).Sheets("Summary").Range("D26").Value
.Sheets("Tabelle1").Cells(lngZeile, 6) = Workbooks(strDatei).Sheets("Summary").Range("J27").Value
.Sheets("Tabelle1").Cells(lngZeile, 7) = Workbooks(strDatei).Sheets("Summary").Range("J28").Value
.Sheets("Tabelle1").Cells(lngZeile, 8) = Workbooks(strDatei).Sheets("Summary").Range("J29").Value
.Sheets("Tabelle1").Cells(lngZeile, 9) = Workbooks(strDatei).Sheets("Summary").Range("K29").Value
.Sheets("Tabelle1").Cells(lngZeile, 10) = Workbooks(strDatei).Sheets("Summary").Range("J31").Value
.Sheets("Tabelle1").Cells(lngZeile, 11) = Workbooks(strDatei).Sheets("Summary").Range("K31").Value
.Sheets("Tabelle1").Cells(lngZeile, 12) = Workbooks(strDatei).Sheets("Summary").Range("J32").Value
.Sheets("Tabelle1").Cells(lngZeile, 13) = Workbooks(strDatei).Sheets("Summary").Range("J35").Value
.Sheets("Tabelle1").Cells(lngZeile, 14) = Workbooks(strDatei).Sheets("Summary").Range("J37").Value
.Sheets("Tabelle1").Cells(lngZeile, 15) = Workbooks(strDatei).Sheets("Summary").Range("K37").Value
.Sheets("Tabelle1").Cells(lngZeile, 16) = Workbooks(strDatei).Sheets("Summary").Range("B40").Value
.Sheets("Tabelle1").Cells(lngZeile, 17) = Workbooks(strDatei).Sheets("Summary").Range("J48").Value
.Sheets("Tabelle1").Cells(lngZeile, 18) = Workbooks(strDatei).Sheets("Summary").Range("J49").Value
.Sheets("Tabelle1").Cells(lngZeile, 19) = Workbooks(strDatei).Sheets("Summary").Range("J57").Value
.Sheets("Tabelle1").Cells(lngZeile, 20) = Workbooks(strDatei).Sheets("Summary").Range("J64").Value
.Sheets("Tabelle1").Cells(lngZeile, 21) = Workbooks(strDatei).Sheets("Summary").Range("J65").Value
.Sheets("Tabelle1").Cells(lngZeile, 22) = Workbooks(strDatei).Sheets("Summary").Range("J66").Value
.Sheets("Tabelle1").Cells(lngZeile, 23) = Workbooks(strDatei).Sheets("Summary").Range("J72").Value
.Sheets("Tabelle1").Cells(lngZeile, 24) = Workbooks(strDatei).Sheets("Summary").Range("J73").Value
.Sheets("Tabelle1").Cells(lngZeile, 25) = Workbooks(strDatei).Sheets("Summary").Range("J74").Value
.Sheets("Tabelle1").Cells(lngZeile, 26) = Workbooks(strDatei).Sheets("Summary").Range("J80").Value
.Sheets("Tabelle1").Cells(lngZeile, 27) = Workbooks(strDatei).Sheets("Summary").Range("J82").Value
.Sheets("Tabelle1").Cells(lngZeile, 28) = Workbooks(strDatei).Sheets("Summary").Range("J83").Value
.Sheets("Tabelle1").Cells(lngZeile, 29) = Workbooks(strDatei).Sheets("Summary").Range("J84").Value
.Sheets("Tabelle1").Cells(lngZeile, 30) = Workbooks(strDatei).Sheets("Summary").Range("J93").Value
.Sheets("Tabelle1").Cells(lngZeile, 31) = Workbooks(strDatei).Sheets("Summary").Range("G94").Value
.Sheets("Tabelle1").Cells(lngZeile, 32) = Workbooks(strDatei).Sheets("Summary").Range("G95").Value
.Sheets("Tabelle1").Cells(lngZeile, 33) = Workbooks(strDatei).Sheets("Summary").Range("G98").Value
.Sheets("Tabelle1").Cells(lngZeile, 34) = Workbooks(strDatei).Sheets("Summary").Range("J103").Value
.Sheets("Tabelle1").Cells(lngZeile, 35) = Workbooks(strDatei).Sheets("Material").Range("E15").Value
.Sheets("Tabelle1").Cells(lngZeile, 36) = Workbooks(strDatei).Sheets("Material").Range("J15").Value
.Sheets("Tabelle1").Cells(lngZeile, 37) = Workbooks(strDatei).Sheets("Material").Range("O15").Value
.Sheets("Tabelle1").Cells(lngZeile, 38) = Workbooks(strDatei).Sheets("Material").Range("P15").Value
.Sheets("Tabelle1").Cells(lngZeile, 39) = Workbooks(strDatei).Sheets("Material").Range("Q15").Value
.Sheets("Tabelle1").Cells(lngZeile, 40) = Workbooks(strDatei).Sheets("Material").Range("R15").Value
.Sheets("Tabelle1").Cells(lngZeile, 41) = Workbooks(strDatei).Sheets("Material").Range("T15").Value
End With
'Quelldatei schließen
Workbooks(strDatei).Saved = True
Workbooks(strDatei).Close
End Sub
Habe versucht es zu verständlich wie möglich zu erklären - leider kann ich die Dateien nicht hochladen, da es berufliche Dateien sind.
Tobi