Hallo Carsten
Da ich wegen Blindheit Office aufgab,
mal ein schuß ins Dunkle.
z.b.
Gruß Nighty
Quelle=Worksheets("Tabelle5")
ändern in=Worksheets(1)
Nanensangabe
Worksheets("Tabelle5")
Indexangabe
Worksheets(1)
Ziel=Worksheets("Mastertabelle")
Entsprechend deinen Bedingungen anpassen!
Pfad(String) wäre an zwei Positionen anzupassen
Option Explicit
Sub DateienLesen()
Call EventsOff
Dim DateiName As String
DateiName = Dir("C:\Temp\" & "*.xls")
Do While DateiName <> ""
If ThisWorkbook.Name <> DateiName Then
Workbooks.Open Filename:="C:\Temp\" & DateiName
Workbooks(DateiName).Worksheets("Tabelle5").Range(Cells(2, 1), Cells(Worksheets("Tabelle5").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Worksheets("Tabelle5").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy _
ThisWorkbook.Worksheets("Mastertabelle").Range("A" & ThisWorkbook.Worksheets("Mastertabelle").Range("A" & Rows.Count).End(xlUp).Row + 1)
Workbooks(DateiName).Close
End If
DateiName = Dir
Loop
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub