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

Tabellenblätter kopieren

Forumthread: Tabellenblätter kopieren

Tabellenblätter kopieren
20.05.2005 08:02:40
pb
Hallo,
habe folgendes Problem:
In einem Ordner befinden sich 50 Dateien, die gleich aufgebaut sind. In jeder Datei befinden sich 20 Tabellenblätter.
Ich brauche ein Makro, das aus jeder Datei des Verzeichnisses ein zu definierendes Tabellenblatt kopiert und diese in eine neue Datei hintereinander einfügt (nur Werte und Formate).
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellenblätter kopieren
20.05.2005 08:17:07
Fritz
Hi pb,
Hast Du schon mal in der Recherche nachgeschaut? Da gibt es viele Beispiele zu Deinem Problem.
Ansonsten ist für die Lösung dieser komplexen Aufgabe eine Beispielmappe notwendig.
Fritz
AW: Tabellenblätter kopieren
20.05.2005 08:30:32
pb
In der Recherche finde ich nichts passendes. Ich hoffe auf einen Freak....
AW: Tabellenblätter kopieren
20.05.2005 09:39:45
UweD
Hallo
hier ist so ein Freak...

Sub alle_Dateien_Verzeichnis()
Dim strPath$, strExt$, strFile$, TB$
strPath = "C:\Temp\" 'Pfad des Verzeichnisses ggf. anpassen
strExt = "*.xls"       'Dateiextension ggf. anpassen
TB = "DerName" ' das zu kopierende Blatt
If strPath = "" Then
Exit Sub
Else
Application.ScreenUpdating = False
strFile = Dir(strPath & strExt)
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
On Error GoTo Fehler ' wenn Blatt nicht enthalten
Workbooks(strFile).Sheets(TB).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Sheets(TB).Cells.Copy
Sheets(TB).Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
[A1].Select
'Umbenennen der Blattes
ActiveSheet.Name = TB & " " & Application.Substitute(strFile, ".xls", "")
weiter:
Workbooks(strFile).Close savechanges:=False
strFile = Dir() ' nächste Datei
Loop
Application.ScreenUpdating = True
End If
Exit Sub
Fehler:
If Err.Number = 9 Then
Err.Clear
MsgBox "Gewünschtes Blatt ist in Datei '" & strFile & "' nicht enthalten!"
GoTo weiter
End If
End Sub

Gruß UweD
Anzeige
AW: Tabellenblätter kopieren
20.05.2005 10:26:14
pb
Genau das brauche ich, allerdings funktioniert es noch nicht.
Das Blatt wird nur aus einer einzigen Datei des Verzeichnisses (nicht der ersten) kopiert.
Woran kann das liegen?
AW: Tabellenblätter kopieren
20.05.2005 10:47:56
UweD
Hallo nochmal
lag scheinbar am Errorhandler:
so klappt es bei mir:

Sub alle_Dateien_Verzeichnis()
Dim strPath$, strExt$, strFile$, TB$
strPath = "C:\Temp\" 'Pfad des Verzeichnisses ggf. anpassen
strExt = "*.xls"       'Dateiextension ggf. anpassen
TB = "DerName" ' das zu kopierende Blatt
If strPath = "" Then
Exit Sub
Else
Application.ScreenUpdating = False
strFile = Dir(strPath & strExt)
On Error Resume Next ' wenn Blatt nicht enthalten
Do While Len(strFile) > 0
Workbooks.Open Filename:=strPath & strFile
Workbooks(strFile).Sheets(TB).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
If Err.Number = 9 Then GoTo Fehler
Sheets(TB).Cells.Copy
Sheets(TB).Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
[A1].Select
'Umbenennen der Blattes
ActiveSheet.Name = TB & " " & Application.Substitute(strFile, ".xls", "")
weiter:
Workbooks(strFile).Close savechanges:=False
strFile = Dir() ' nächste Datei
Loop
Application.ScreenUpdating = True
End If
Exit Sub
Fehler:
Err.Clear
MsgBox "Gewünschtes Blatt ist in Datei '" & strFile & "' nicht enthalten!"
GoTo weiter
End Sub

Gruß Uwe
Anzeige
AW: Tabellenblätter kopieren
20.05.2005 13:41:23
pb
Hi Uwe,
funktioniert super. Vielen Dank
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige