Hallo Uwe,
nachfolgende Makros kopieren Dir die Daten aus einem bestimmten Ordner und allen darin befindlichen Unterordner aus allen darin befindlichen Exceldateien. Kopiert werden die Daten aus dem Tabellenblatt mit dem Namen „Tabelle1“ Zellen C3, E3, B33 und B34 in die aktuelle Datei in das Tabellenblatt mit dem Namen „Tabelle1“ in die Spalten A, B, C und D.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Dim Obj As Object
Dim objAnzDateien As Object
Dim objDurchläufe As Object
Dim objDateityp As Object
Dim lngFirstFreeRow As Long
Dim wkbQuelldatei As Workbook
Const strQuellSheet = "Eingabe"
Const strZielSheet = "Tabelle1"
Const strPath = "C:\tmp"
Sub Start()
Set Obj = CreateObject("Scripting.FileSystemObject")
Set objAnzDateien = Obj.getfolder(strPath)
Auslesen
End Sub
Sub Auslesen()
On Error GoTo ERRORHANDLER
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For Each objDateityp In objAnzDateien.Files
If Right(objDateityp.Name, 4) = ".xls" Then
Application.StatusBar = "Workbook " & objDateityp.Name & " wird ausgelesen..."
DoEvents
Set wkbQuelldatei = Workbooks.Open(objDateityp.Path)
lngFirstFreeRow = ThisWorkbook.Sheets(strZielSheet).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
wkbQuelldatei.Sheets(strQuellSheet).Range("C3").Copy _
ThisWorkbook.Sheets(strZielSheet).Cells(lngFirstFreeRow, 1)
wkbQuelldatei.Sheets(strQuellSheet).Range("E3").Copy _
ThisWorkbook.Sheets(strZielSheet).Cells(lngFirstFreeRow, 2)
wkbQuelldatei.Sheets(strQuellSheet).Range("B33").Copy _
ThisWorkbook.Sheets(strZielSheet).Cells(lngFirstFreeRow, 3)
wkbQuelldatei.Sheets(strQuellSheet).Range("B34").Copy _
ThisWorkbook.Sheets(strZielSheet).Cells(lngFirstFreeRow, 4)
ActiveWorkbook.Close True
End If
Next
For Each objDurchläufe In objAnzDateien.subfolders
Set objAnzDateien = objDurchläufe
Auslesen
Next
ERRORHANDLER:
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
.Calculate
.StatusBar = ""
End With
Set wkbQuelldatei = Nothing
End Sub
In dem Makro musst Du in den Zeilen
Const strQuellSheet = "Eingabe"
Const strZielSheet = "Tabelle1"
Const strPath = "C:\tmp"den Namen des Tabellenblatts aus den zu öffnenden Dateien, den Namen des Blatts, in das die Daten kopiert werden sollen und den 1. Ordner, in dem sich dann alle weiteren Unterordner befinden, anpassen/ ändern.
Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf
meiner HP in der
Rubrik Anleitungen und dort dann in der
Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.
Bei Fragen melde Dich.
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du[/sub]
[sup] ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sup]
