Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1316to1320
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

Dateien zusammenfassen

Dateien zusammenfassen
03.06.2013 11:38:11
Hokweb
Hallo,
ich habe schon etwas im Archiv "gewühlt" aber leider habe ich nicht das richtige gefunden. Eventuell kann mir doch einer weiterhelfen.
Ich habe 14 Exceldateien mit jeweils einem Tabellenblatt in einem Ordner nun möchte ich das daraus eine Exceldatei mit 14 Tabellenblättern wird.
Für die Hilfe wäre ich sehr dankbar.
Holger

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

Betreff
Datum
Anwender
Anzeige
AW: Dateien zusammenfassen
03.06.2013 11:41:25
Klaus
Hallo Holger,
öffne alle 14 Dateien, und eine neue leere Datei.
Clicke in jeder Datei das Tabellenblatt mit rechts an, dann auf "Move or Copy", dann "create a copy" anhaken, oben in der Combobox die leere Datei auswählen, OK.
Bei 14 Dateien bist du innerhalb von unter 100 Mausclicks fertig, da lohnt sich das programmieren eines Makros nicht.
Grüße,
Klaus M.vdT.

AW: Dateien zusammenfassen
03.06.2013 11:45:30
Hokweb
Hallo Klaus,
da hast du schon recht, das dies nicht allzuviel Mausklicks sind, nur habe ich 5 Ordner und das jeden Monat vom neuen.
Trotzdem Danke
Holger

AW: Dateien zusammenfassen
03.06.2013 11:45:37
Hokweb
Hallo Klaus,
da hast du schon recht, das dies nicht allzuviel Mausklicks sind, nur habe ich 5 Ordner und das jeden Monat vom neuen.
Trotzdem Danke
Holger

Anzeige
AW: Dateien zusammenfassen
03.06.2013 11:58:26
Klaus
Hi Holger,
für einen fixen Ordner geht es zB so:
Option Explicit
Sub MacheEineGrosseDateiAusVielenImOrdner()
Dim sFile As String, sPath As String
Dim wkbOld As Workbook
Dim wkbNew As Workbook
'hier DEINEN Pfad angeben!
sPath = "C:\TestTMP"
'grade aktives Workbook merken
Set wkbOld = ActiveWorkbook
'Pfadangabe bereinigen
If Right(sPath, 1)  "/" Then
sPath = sPath & "\"
End If
'Dateiliste erstellen
sFile = Dir(sPath & "*.xls*") '.xls* öffnet xls, xlsx, xlsm usw ...
'Jede Datei im Pfad durchgehen
Do While sFile  ""
'Datei öffnen
Workbooks.Open sPath & sFile
'Datei merken
Set wkbNew = ActiveWorkbook
'Tabelle ins alte Workbook kopieren
'es wird immer das AKTIVE sheet kopiert!
'da du schreibst, die Dateien haben nur ein Sheet, ist es das richtige.
ActiveSheet.Copy Before:=wkbOld.Sheets(1)
'Dateizähler hochsetzen
sFile = Dir()
'Datei schließen ohne zu speichern
wkbNew.Close False
Loop
Application.ScreenUpdating = True
End Sub
'*********************************************************************************************** _
'* Module to open needed files. Checks if Files are open or not.
'* If file is already open, do nothing - else open it
'* stolen from: https://www.herber.de/mailing/Pruefen_ob_Arbeitsmappe_geoeffnet_und_wenn_nein_oeffnen.htm
'* modified by Klaus Meyer von der Twer / 16.NOV.2012
'*********************************************************************************************** _
'Example:
'Call FileCheckOpen("C:\TMP", "Filename.xls")
'path and filename can be RANGE from excelsheet
Sub FileCheckOpen(sPath As String, sFile As String)
sPath = sPath & "/" & sFile
If WkbExists(sFile) = False Then
If Dir(sPath) = "" Then
MsgBox "File " & sPath & " not found!"
Else
Workbooks.Open sPath, UpdateLinks:=False
End If
Else
Workbooks(sFile).Activate
End If
End Sub
Function WkbExists(sFile As String) As Boolean
Dim wkb As Object
On Error Resume Next
Set wkb = Workbooks(sFile)
If Not wkb Is Nothing Then
WkbExists = True
End If
On Error GoTo 0
End Function
Function WksSheetExists(sSheet As String) As Boolean
Dim wks As Object
On Error Resume Next
Set wks = Sheets(sSheet)
If Not wks Is Nothing Then
WksSheetExists = True
End If
On Error GoTo 0
End Function
Die Pfadangabe dynamisiert bekommst du selber?
Grüße,
Klaus M.vdT.

Anzeige
zuviel kopiert ;-)
03.06.2013 12:01:50
Klaus
Hallo Holger,
du brauchst nur das erste SUB :-)
Aus dem Zielordner darf keine Datei geöffnet sein, bevor du das Makro startest! Eleganterweise sollte die Mutterdatei mit dem Makro in einem anderem Ordner liegen, da sie sich sonst selbst zu öffnen versucht.
Auf eventuelle Fußangeln, wie Workbook_Open Makros in den Dateien, gehe ich (noch) nicht ein.
Option Explicit
Sub MacheEineGrosseDateiAusVielenImOrdner()
Dim sFile As String, sPath As String
Dim wkbOld As Workbook
Dim wkbNew As Workbook
'hier DEINEN Pfad angeben!
sPath = "C:\TestTMP"
'grade aktives Workbook merken
Set wkbOld = ActiveWorkbook
'Pfadangabe bereinigen
If Right(sPath, 1)  "/" Then
sPath = sPath & "\"
End If
'Dateiliste erstellen
sFile = Dir(sPath & "*.xls*") '.xls* öffnet xls, xlsx, xlsm usw ...
'Jede Datei im Pfad durchgehen
Do While sFile  ""
'Datei öffnen
Workbooks.Open sPath & sFile
'Datei merken
Set wkbNew = ActiveWorkbook
'Tabelle ins alte Workbook kopieren
'es wird immer das AKTIVE sheet kopiert!
'da du schreibst, die Dateien haben nur ein Sheet, ist es das richtige.
ActiveSheet.Copy Before:=wkbOld.Sheets(1)
'Dateizähler hochsetzen
sFile = Dir()
'Datei schließen ohne zu speichern
wkbNew.Close False
Loop
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Dateien zusammenfassen
03.06.2013 12:15:07
Hokweb
Danke Klaus,
funktioniert super.
Einen schönen Tag wünscht Holger

Danke für die Rückmeldung! owT.
03.06.2013 12:16:16
Klaus
.

AW: Dateien zusammenfassen
03.06.2013 12:08:52
Rudi
Hallo,
prinzipiell so:
Sub aaaa()
Dim sFolder As String, sFile As String
Dim wkbNeu As Workbook, wkb As Workbook
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Ordner wählen"
If .Show = -1 Then
sFolder = .SelectedItems(1)
End If
End With
If sFolder  "" Then
sFolder = sFolder & "\"
sFile = Dir(sFolder & "*.xls*")
Do While sFile  ""
Set wkb = Workbooks.Open(sFolder & sFile)
If wkbNeu Is Nothing Then
wkb.Sheets(1).Copy
Set wkbNeu = ActiveWorkbook
Else
wkb.Sheets(1).Copy before:=wkbNeu.Sheets(1)
End If
wkb.Close False
sFile = Dir
Loop
End If
End Sub

Gruß
Rudi

Anzeige
AW: Dateien zusammenfassen
03.06.2013 12:14:25
Hokweb
Danke Rudi,
für deine Lösung - habe das Makro von Klaus probiert funktioniert.
Einen schönen Tag wünscht Holger

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige