Live-Forum - Die aktuellen Beiträge
Datum
Titel
16.10.2025 17:40:39
16.10.2025 17:25:38
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zusammenkopieren mehrerer Excel Dateien in eine Da

Forumthread: Zusammenkopieren mehrerer Excel Dateien in eine Da

Zusammenkopieren mehrerer Excel Dateien in eine Da
20.04.2016 14:35:02
Martin

Hallo,
ich möchte gerne von mehreren Excel Dateien die Daten ab Zeile 2 in eine Excel Tabelle zusammenfügen.
Die Dateien und Zusammenfassung liegen in einem Ordner.
Ich verwende den Folgenden VBA-Code welcher gut funkltioniert, nur werden immer die aktiven Tabellen importiert. Wie kann ich den Code anpassen damit jeweils die Tabelle Ergebnis importiert wird?

Sub zusammenfuegen()
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
With ThisWorkbook.Worksheets("Ergebnisberichte")
Do While strDateiname <> ""
If strDateiname <> ThisWorkbook.Name Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & strDateiname
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells( _
xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell) _
_
_
.Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy   _
_
_
Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub

Besten Dank für die Unterstützung
Martin

Anzeige

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zusammenkopieren mehrerer Excel Dateien in eine Da
20.04.2016 14:46:02
Rudi Maintaire
Hallo,
ist doch logisch.
anstatt
ActiveWorkbook.ActiveSheet
ActiveWorkbook.Sheets("Ergebnis")
Gruß
Rudi

AW: Zusammenkopieren mehrerer Excel Dateien in eine Da
20.04.2016 14:47:31
Fennek
Hallo,
Genies mögen mit 'with...' und 'activeworkbook...' zurechtkommen, aber ich finde es übersichtlicher sehr eindeutig zu referenzieren.
Am Anfang
Dim WBZ as workbook 'Ziel
Dim WBQ as workbook 'Quelle
und dann alle Code zuordnen
Qbq.sheets(1). usw
Man muss weniger tippen und es ist m.e. übersichtlicher. Da bei 'workbook.open' der Focus auf die neue Datei springt, finde ich das zu unübersichtlich.
Mfg

Anzeige
AW: Zusammenkopieren mehrerer Excel Dateien in eine Da
20.04.2016 15:14:41
Martin
Hallo,
Danke für die rasche Unterstützung, könnt ihr den Code bitte angepast einfügen.
Kenn mich leider nicht so gut aus.
Besten Dank

AW: Hast du die Vorschläge von Rudi versucht?
20.04.2016 20:51:49
Fennek
Hi,
sofern die Daten immer im sheets(1) stehen, sollte dieser Code helfen.

Sub sFen()
Dim WBQ as workbook
Dim WSZ as worksheet
Set wsz = this workbook.activesheet
sPfad = thisworkbook.path & "\"
meN = thisworkbook.name
sFile = dir(sPfad & "*.xls*)
Do while sFile <> ""
If sFile <> meN then
lr = wsz.cells(rows.count, "A").end(xlup).row+1
With getobject(sPfad & sFile)
.sheets(1).range("a1").currentregion.copy wsz.cells(lr, "A")
.close 0
End with
Wsz.rows(lr).delete
End if
sFile = dir
Loop
End sub
Mfg

Anzeige
AW: Hast du die Vorschläge von Rudi versucht?
21.04.2016 09:45:14
Martin
Hallo,
ich habe nun noch das Problem das ich von einem Netzlaufwerk die Tabellen einfügen kann.
Wird der Ordner Lokal abgespeichert funktioniert es bestens.
Kann mir bitte jemand verraten wo der Fehler liegt.
Sub zusammenfuegen()
ActiveSheet.Range(Rows(3), Rows(Rows.Count)).Delete
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
Pathname = "\\10.0.0.3\Projekte\Ergebnisberichte"
With ThisWorkbook.Worksheets("Ergebnisberichte")
Do While strDateiname <> ""
If strDateiname <> ThisWorkbook.Name Then
Workbooks.Open Filename:=Pathname & "\" & strDateiname
Sheets("Kompetenz Check Liste").Select
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.Sheets("Kompetenz Check Liste").UsedRange. _
SpecialCells(xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.Sheets("Kompetenz Check Liste").UsedRange. _
SpecialCells(xlCellTypeLastCell).Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy  _
Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub
Besten Dank

Anzeige
AW: Zusammenkopieren mehrerer Excel Dateien in eine Da
21.04.2016 10:22:48
Martin
Hallo,
ich habe nun noch das Problem das ich von einem Netzlaufwerk die Tabellen einfügen kann.
Wird der Ordner Lokal abgespeichert funktioniert es bestens.
Kann mir bitte jemand verraten wo der Fehler liegt.
Sub zusammenfuegen()
ActiveSheet.Range(Rows(3), Rows(Rows.Count)).Delete
Dim strDateiname As String
Dim loLetzte1 As Long
Dim loLetzte2 As Long
Dim inLetzte As Integer
Application.ScreenUpdating = False
strDateiname = Dir(ThisWorkbook.Path & "\*.xls")
Pathname = "\\10.0.0.3\Projekte\Ergebnisberichte"
With ThisWorkbook.Worksheets("Ergebnisberichte")
Do While strDateiname <> ""
If strDateiname <> ThisWorkbook.Name Then
Workbooks.Open Filename:=Pathname & "\" & strDateiname
Sheets("Kompetenz Check Liste").Select
loLetzte1 = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
loLetzte2 = ActiveWorkbook.Sheets("Kompetenz Check Liste").UsedRange. _
SpecialCells(xlCellTypeLastCell).Row
inLetzte = ActiveWorkbook.Sheets("Kompetenz Check Liste").UsedRange. _
SpecialCells(xlCellTypeLastCell).Column
ActiveWorkbook.ActiveSheet.Range(Cells(3, 1), Cells(loLetzte2, inLetzte)).Copy  _
Destination:=.Cells(loLetzte1 + 1, 1)
ActiveWorkbook.Close True
End If
strDateiname = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub
Besten Dank

Anzeige
AW: Dos(en)?
21.04.2016 10:55:24
Fennek
Hallo,
Der Pfad wird zweimal vergeben: einmal mit 'thisworkbook.path' und dann nochmal mit 'pathname'.
Frage mal deinen Admin, ob du Netzwerklaufwerke mit durch Zuweisung eines eines Windowslaufwerksbuchstaben einbinden kannst.
Mfg

AW: Dos(en)?
21.04.2016 10:59:18
Martin
Hallo Fennek,
das Laufwerk Projekte ist auch unter W: zugewiesen.
Wie soll ich den Code anpassen?
Besten Dank

Anzeige
AW: Zusammenkopieren mehrerer Excel Dateien in eine Da
21.04.2016 11:12:23
Fennek
Hallo,
Pfadnamen gehören in die erste Stunde jedes Pc-Führerschein.
Ungeprüft:
Vor strDateiname
sPfad = "w:\ usw \"
Die Zeile mit 'workbook.path' auskommentieren (Kommentarzeichen ')
Alle Stellen mit Pfad-Namen prüfen.
Mfg

;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige