AW: Daten aus mehreren Tabellenblättern auslesen
11.11.2019 19:09:13
volti
Hallo Josi,
falls das Thema noch offen sein sollte, hier mal ein Ansatz, wie Du die Übernahme aus den 38 Blättern erreichen kannst.
Angenommen wurde, dass der Code in der Ergebnisdatei enthalten ist. Diese darf daher keine .xlsx sein, sondern muss eine ausführbare Version .xlsm oder .xlsb sein.
Den Code dort in ein Modul kopieren.
Angenommen wurde ebenfalls, dass sich die Ergebnisdatei mit im betreffenden Ordner befindet und ansonsten sich dort ausschließlich die Importdateien befinden.
Leider konnte ich das nicht ausreichend testen, da ich Deine Vorraussetzungen und Dateien ja nicht habe. Probiere es einfach mal aus...
Sub OrteUebernehmen()
Dim sDatei As String, sPfad As String
Dim QWSh As Worksheet, ZWSh As Worksheet
Dim QWKb As Workbook
Dim iZeile As Long, iOutZeile As Long, iSpalte As Integer
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
' sPfad = "C:\MeinPfad\" 'ggf. anpassen oder weg
sPfad = ThisWorkbook.Path & "\" 'ggf. weg
sDatei = Dir(sPfad & "*.xlsx")
Set ZWSh = ThisWorkbook.Sheets("Import") 'Blattreferenz setzen
Do While sDatei <> ""
If sDatei <> ThisWorkbook.Name Then
Workbooks.Open Filename:=sPfad & sDatei 'Datei öffnen
On Error Resume Next
Set QWKb = ActiveWorkbook
Set QWSh = QWKb.Sheets("Ergebnisse") 'Quellblattreferenz setzen
If Not QWSh Is Nothing Then
For iZeile = 9 To QWSh.UsedRange.Rows.Count
iOutZeile = 0
iOutZeile = Application.WorksheetFunction.Match( _
QWSh.Cells(iZeile, "B").Value, ZWSh.Range("A:A"), 0)
If iOutZeile > 0 Then
For iSpalte = 5 To QWSh.UsedRange.Columns.Count + 5
With ZWSh.Cells(iOutZeile, iSpalte)
If .Value = "" Or .Value = QWSh.Range("B1").Value Then
.Value = QWSh.Range("B1").Value 'Text übernehmen und raus
Exit For
End If
End With
Next iSpalte
End If
Next iZeile
End If
QWKb.Close SaveChanges:=False 'Datei schließen, nicht speichern
End If
sDatei = Dir 'Nächste Datei
Loop
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
MsgBox "Bin Fertig", vbOKOnly Or vbInformation, "Turnierauswertung"
End Sub
viele Grüße
Karl-Heinz