Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 06:38:45
Kumulierte Daten für Intervalllaufeinheiten
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1228to1232
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1228to1232
1228to1232
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Dateien in Pfad in neuer Datei speichern

Dateien in Pfad in neuer Datei speichern
Peter

Guten Tag
Ich habe in einem Ordner (Pfad in strExpPfad abgelegt) ca 60 Dateien, aus welchen ich nur die "Tabelle1" in eine neue Datei "Exporte.xls" übernehmen will. Für jede Datei soll in der neuen Datei "Exporte.xls" eine Tabelle angelegt werden, welche mit dem bisherigen Dateinamen benannt wird.
Beispiel: 103373.xls (eine der rund 60 Tabellen)
Aus dieser Datei soll das Worksheet "Tabelle1" in die Datei "Exporte.xls" kopiert werden, die Tabelle soll dann mit dem Namen "103373" benannt werden.
Ich schaffe es leider nicht, die Tabellen zu öffnen und in der neuen Datei mit dem gewünschten Worksheet-Namen abzuspeichern.
Wäre super, wenn mir da jemand helfen kann.
Gruss, Peter

Sub Exporte_in_eine_Datei()
Dim strTmpName As String, strExpPfad As String, wkb As Workbook
strExpPfad = ThisWorkbook.Sheets("Cockpit").Range("expPfad") & "\" 'Pfad der Exporte
strTmpName = "Exporte.xls"
Workbooks.Add
ActiveWorkbook.SaveAs Filename:=strExpPfad & strTmpName
'jede Tabelle im angegebenen Pfad öffnen, "Tabelle1" kopieren in eine Tabelle, welche mit dem
'Namen der Datei (ohne Extension .xls) benannt wird
''''Weiterverarbeiten Daten Exporte.xls
'Temporäre Datei schliessen ohne zu speichern
For Each wkb In Workbooks
If wkb.Name = strTmpName Then
wkb.Close savechanges:=False
Kill strExpPfad & strTmpName
Exit Sub
End If
Next wkb
End Sub

AW: Dateien in Pfad in neuer Datei speichern
15.09.2011 17:19:46
Piet
Hallo Peter,
versuchs mal hiermit:

Sub Exporte_in_eine_Datei()
Dim strTmpName As String, strExpPfad As String, wkb As Workbook, FoundFile As String
strExpPfad = ThisWorkbook.Sheets("Cockpit").Range("expPfad") & "\" 'Pfad der Exporte
strTmpName = "Exporte.xls"
'Workbooks.Add
'ActiveWorkbook.SaveAs Filename:=strExpPfad & strTmpName
'jede Tabelle im angegebenen Pfad öffnen, "Tabelle1" kopieren in eine Tabelle, welche mit dem
'Namen der Datei (ohne Extension .xls) benannt wird
With Application.FileSearch
.NewSearch
.LookIn = strExpPfad
.SearchSubFolders = False
.Filename = "*.xls"
.MatchTextExactly = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.Open (.FoundFiles(i))
FoundFile = Replace(.FoundFiles(i), strExpPfad, "")
If i = 1 Then
Workbooks(FoundFile).Sheets("Tabelle1").Copy
ActiveWorkbook.SaveAs Filename:=strExpPfad & strTmpName
Else
Sheets("Tabelle1").Copy Before:=Workbooks(strTmpName).Sheets(1)
End If
Workbooks(strTmpName).Sheets("Tabelle1").Name = Replace(FoundFile, ".xls", "")
Workbooks(FoundFile).Close SaveChanges:=False
Next i
Else
MsgBox "There were no files found."
End If
End With
''''Weiterverarbeiten Daten Exporte.xls
'Temporäre Datei schliessen ohne zu speichern
For Each wkb In Workbooks
If wkb.Name = strTmpName Then
wkb.Close SaveChanges:=False
Kill strExpPfad & strTmpName
Exit Sub
End If
Next wkb
End Sub

Gruß
Piet
Anzeige
AW: Dateien in Pfad in neuer Datei speichern
15.09.2011 22:50:53
Peter
Hallo Piet
ich danke dir! Kann's erst morgen austesten. Allerdings habe ich gelesen, dass FileSearch im Excel 2010 nicht mehr geht - eine Umstellung auf die neue Version steht vor der Tür. Deshalb lasse ich den Eintrag nochmals offen - vielleicht hat ja jemand eine Alternative.
Vielen Dank und Gruss, Peter
AW: Dateien in Pfad in neuer Datei speichern
16.09.2011 12:22:12
Rudi
Hallo,
andere Version:

Sub Exporte_in_eine_Datei()
Dim strTmpName As String, strExpPfad As String, wkb As Workbook, strFile As String
Dim wkbExp As Workbook
strExpPfad = ThisWorkbook.Sheets("Cockpit").Range("expPfad") & "\" 'Pfad der Exporte
strTmpName = "Exporte.xls"
strFile = Dir(strExpPfad & ".xls")
If strFile = "" Then
MsgBox "Keine Dateien gefunden!", vbOKOnly, "Gebe bekannt ..."
Exit Sub
End If
'jede Tabelle im angegebenen Pfad öffnen, "Tabelle1" kopieren in eine Tabelle, welche mit dem
'Namen der Datei (ohne Extension .xls) benannt wird
Do While strFile  ""
If wkbExp Is Nothing Then Set wkbExp = Workbooks.Add(1)
Set wkb = Workbooks.Open(strExpPfad & strFile)
wkb.Sheets("Tabelle1").Copy before:=wkbExp.Sheets(1)
wkbExp.Sheets(1).Name = Left(strFile, Len(strFile) - 4)
wkb.Close False
strFile = Dir
Loop
With wkbExp
Application.DisplayAlerts = False
.Sheets(.Sheets.Count).Delete
Application.DisplayAlerts = True
.SaveAs strExpPfad & strTmpName
End With
End Sub

Gruß
Rudi
Anzeige
AW: Dateien in Pfad in neuer Datei speichern
17.09.2011 14:37:44
Peter
Hallo Rudi
Vielen Dank für diese Variante.
Ich habe den Code jetzt in einer Umgebung gestestet, wo die Endungen der Dateien nicht angezeigt werden.
strFile = Dir(strExpPfad & "") '& ".xls"
If strFile = "" Then
Ich nehme an, dass man nicht auf eine andere Weise die Dateien als Excel-Dateien identifizieren kann.
Es gibt jedoch ein anderes Identifikationsmerkmal dieser Excel-Dateien: Jede hat 6 Zeich en (Zahlen oder Buchstaben).
Wie muss ich den Code (wohl obiger Teil) anpassen, dass das mit dieser Eingrenzung klappt?
Danke und Gruss, Peter
AW: Dateien in Pfad in neuer Datei speichern
19.09.2011 08:57:04
Rudi
Hallo,
strFile = Dir(strExpPfad & "?.xls")
Gruß
Rudi
Anzeige
AW: Dateien in Pfad in neuer Datei speichern
19.09.2011 09:20:55
Peter
Hallo Rudi
Vielen Dank!
Da ich diesen Thread (erster Eintrag 15.9.2011) nicht mehr sah, habe ich ein neues Problem in einem neuen Tread gepostet.
Interessanterweise klappt es jetzt mit strFile = Dir(strExpPfad & "?.xls") wieder - die Dateien werden im Ordner erkannt.
Gruss, Peter
AW: Dateien in Pfad in neuer Datei speichern
19.09.2011 09:36:16
Peter
Hallo Rudi
Komischerweise öffnet es nur die erste Datei im Ordner.
Ich mache jetzt im heutigen Thread weiter.
Nochmals vielen Dank und Gruss, Peter

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige