Excel aus mehrer datei rauskopieren

Computer: Software & Programmierung Office Software
1

Hallo zusammen,

weiß jemand wie man stumpf aus mehreren Excel Dateien sämtliche Zeilen in einem angegebenen Bereich (B 3 bis D 10) untereinander in eine Gesamttabelle kopieren kann?

Sagen wir mal 3 Dateien:
Dat1
Dat2
Dat3

daraus soll

Dat4 mit den beschriebenen Zeilen der 3 Datensätze werden. Die Werte der Zellen des jeweils identischen Wertebereichs (B 3 bis D 10) der Ursprungsdateien Dat1 Dat2 Dat3 sollen in Dat4 einfach untereinander kopiert werden.

Ich habe folgendes Makro, aber ich suche nach einem Weg direkt einen Ordner mit den Ursprungsdateien angeben zu können. Bei dem Makro muss ich jeweils die einzelnen Datei auswählen und ich habe 623 Ursprungsdateien!

Danke schon mal!

Sub tt()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
dat = True
While dat = True
dat = Application.GetOpenFilename(„xls Files (*.xls), *.xls“)
Workbooks.Open dat
zeiQuelle = Sheets(1).Range(„a65536“).End(xlUp).Row
zeiZiel = ThisWorkbook.Sheets(1).Range(„a65536“).End(xlUp).Row
Range(Rows(1), Rows(zeiQuelle)).Copy Destination:=ThisWorkbook.Sheets(1).Cells(zeiZiel, 1)
ActiveWorkbook.Close SaveChanges:=False
Wend
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

2

Dat4 mit den beschriebenen Zeilen der 3 Datensätze werden. Die
Werte der Zellen des jeweils identischen Wertebereichs (B 3
bis D 10) der Ursprungsdateien Dat1 Dat2 Dat3 sollen in Dat4
einfach untereinander kopiert werden.

Hallo Fabienne,

versuchs mal so:

Sub tt2()
Dim Dat As Variant, Zei As Long, D As Byte
Const Pfad As String = "C:\test\"
Dat = Array("Dat1.xls", "Dat2.xls", "Dat3.xls")
With ThisWorkbook.Worksheets("Tabelle1")
 For D = 0 To 2
 Zei = .Cells(Rows.Count, 1).End(xlUp).Row + 1
 Workbooks.Open Pfad & Dat(D)
 ActiveWorkbook.Worksheets("Tabelle1").Range("B3:smiley:10").Copy Destination:=.Cells(Zei, 1)
 ActiveWorkbook.Close savechanges:=False
 Next D
End With
End Sub

Gruß
Reinhard