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

Forumthread: Arbeitsblaetter aus Datei in Arbeitsmappe kopieren

Arbeitsblaetter aus Datei in Arbeitsmappe kopieren
16.09.2008 06:03:00
Benjamin
Hallo erstmal,
normalerweise lese ich immer nur und finde alle loesungen, diesmal hab ich einfach nichts gefunden.
Ich wuerde gerne als sehr vielen Dateien immer das komplette dritte Arbeitsbaltt kopieren und in einer neuen Arbeitsmappe untereinander einfuegen. Hab auch schon einen ansatz gefunden, der leider nicht richtig funktionier aber von der Bedienung genau das ist, was ich mir vorstellen wuerde:

Sub copy()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
dat = True
While dat = True
dat = Application.GetOpenFilename("xls Files (*.xls), *.xls")
Workbooks.Open dat
zeiQuelle = Sheets(3).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


Wenn ihr mehr informationen benoetig einfach fragen.
Vielleicht hab jemand eine Idee, ich waer sehr dankbar.
Viele Gruesse
Benjamin

Anzeige

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Arbeitsblaetter aus Datei in Arbeitsmappe kopieren
16.09.2008 10:23:03
Gerd
Hallo Benjamin!

Sub Kopieren()
Dim dat As Variant, zeiquelle As Long, zeiziel As Long
Application.DisplayAlerts = False
Application.ScreenUpdating = False
On Error goto Ende
dat = True
Do While Not dat = False
dat = Application.GetOpenFilename("xls Files (*.xls), *.xls")
If Not dat = False Then
Workbooks.Open dat
zeiquelle = Sheets(3).Range("a65536").End(xlUp).Row
zeiziel = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row
If zeiquelle + zeiziel > 65536 Then MsgBox "Full House!": Exit Do
If zeiziel > 1 Then zeiziel = zeiziel + 1
Sheets(3).Range(Sheets(3).Rows(1), Sheets(3).Rows(zeiquelle)).copy _
Destination:=ThisWorkbook.Sheets(1).Cells(zeiziel, 1)
Workbooks(Dir(dat)).Close SaveChanges:=False
End If
Loop
Ende:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub


- "


Sub Copy", Makros nicht mit VBA-Befehlswörtern benennen
- Variablen besser deklarieren
- Die neue Datei ist die, in der der Code steht
- Meßlatte ist Spalte A des Sheets(3) aus dem kopiert wird
Gruß Gerd

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

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