Anzeige
Archiv - Navigation
1488to1492
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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

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

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

Anzeige
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

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

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

Anzeige

299 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige