Supportnet / Forum / Tabellenkalkulation
Excel: Tabellenblätter aus Dateien automatisch in eine einzige neue Datei kopieren
Frage
Hallo zusammen!
Ich habe mehere Dateien, in der jeweils ein Tabellenblatt mit jeweils dem gleichen Namen existiert.
Nun möchte ich, dass Excel diese Tabbellenblätter in eine neue Excel-Datei kopiert, sprich alle Tabellenblätter aus den einzelnen Dateien dann in einer einzigen Datei sind. Dabei sollte jedes Tabellenblatt dann jeweils so wie die Datei heißen, aus der es stammt.
Ich weiß nicht, ob das möglich ist, wenn ja, wäre es echts uper wenn sich jemand die Zeit nimmt und mir zeigt, wie es geht. Vielen Dank!
Gruß Cerrio
Antwort 1 von Saarbauer
Hallo,
grundsätzlich mit VBA möglich, jedoch reichen deine Angaben für einen richtigen Vorschlag nicht aus.
Sinngemäß:
1. Einlesen der Dateinamen
2. Erzeugen der Tabellenblätter mit "Dateinamen"
3. Übertragen der Daten aus Datei auf Tabellenblatt
Gruß
Helmut
grundsätzlich mit VBA möglich, jedoch reichen deine Angaben für einen richtigen Vorschlag nicht aus.
Sinngemäß:
1. Einlesen der Dateinamen
2. Erzeugen der Tabellenblätter mit "Dateinamen"
3. Übertragen der Daten aus Datei auf Tabellenblatt
Gruß
Helmut
Antwort 2 von Cerrio
Hallo Helmut!
Ganz genau, darum geht es :-)
der Inhalt der "alten" Dateien sollen dann auf dem Tabellenblatt mit dem entsprechenden "alten" (Datei-)namen in der neuen Datei stehen.
Gruß Cerrio
Ganz genau, darum geht es :-)
der Inhalt der "alten" Dateien sollen dann auf dem Tabellenblatt mit dem entsprechenden "alten" (Datei-)namen in der neuen Datei stehen.
Gruß Cerrio
Antwort 3 von Saarbauer
Hallo,
teste mal das Makro, ob es deinen Vorstellungen entspricht.
Ich habe keine Löschfunktion für vorhandene Arbeitsblätter eingebaut, da ich deine Tabellen nicht kenne. Ich gehe davon aus, dass du kenen Namen der zu übertragenden Dateien in deiner Zusammenstellung drin hast.
Gruß
Helmut
teste mal das Makro, ob es deinen Vorstellungen entspricht.
Sub Dateien_Erfassung()
Dim Mappen As Integer
Pfad = "C:\Users\Helmut\Documents\" 'hier muss der Passende Pfad eingefügt werden
Pfad_Länge = Len(Pfad)
With Application.FileSearch
.NewSearch
.LookIn = Pfad
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 1 Then
For Mappen = 1 To .FoundFiles.Count
If .FoundFiles(Mappen) <> "Zusammenstellung" Then
Workbooks.Open Filename:=.FoundFiles(Mappen)
Name = Mid(.FoundFiles(Mappen), Pfad_Länge + 1, 50)
Text_Länge = Len(Name)
Name = Mid(Name, 1, Text_Länge - 4) 'Wert -4 ist zu ändern, wenn nicht Endung .xls ist
Workbooks(1).Activate
Sheets.Add
Sheets(Sheets.Count - 1).Select
Sheets(Sheets.Count - 1).Move After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = Name
Workbooks(2).Activate
Sheets("Tabelle1").Select
Cells.Select
Selection.Copy
Workbooks(1).Activate
Sheets(Name).Select
Range("A1").Select
ActiveSheet.Paste
Workbooks(2).Close
End If
Next Mappen
End If
End With
End Sub
Ich habe keine Löschfunktion für vorhandene Arbeitsblätter eingebaut, da ich deine Tabellen nicht kenne. Ich gehe davon aus, dass du kenen Namen der zu übertragenden Dateien in deiner Zusammenstellung drin hast.
Gruß
Helmut
Antwort 4 von gast123
hi all :-))
ausgehend von einer neuen mappe mit 3 tabellenblaettern,die dann heissen Tabelle1,Tabelle2,Tabelle3
automatische abtastung und integration von doppelt benannten dateien bezugnehmend auf eine automatische generierung der tabellen
quelle bzw worksheet ist zur zeit Tabelle1 benannt, dieses waere anzupassen ,wie der pfad auch der zur zeit c:\temp\ ist
gruss gast123
ausgehend von einer neuen mappe mit 3 tabellenblaettern,die dann heissen Tabelle1,Tabelle2,Tabelle3
automatische abtastung und integration von doppelt benannten dateien bezugnehmend auf eine automatische generierung der tabellen
quelle bzw worksheet ist zur zeit Tabelle1 benannt, dieses waere anzupassen ,wie der pfad auch der zur zeit c:\temp\ ist
gruss gast123
Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp\"
.SearchSubFolders = False
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
If SheetExists("" & Mid(DateiName, 1, Len(DateiName) - 4)) = False Then
ThisWorkbook.Worksheets.Add , ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count).Name = Mid(DateiName, 1, Len(DateiName) - 4)
Workbooks(DateiName).Worksheets("Tabelle1").Range(Workbooks(DateiName).Worksheets("Tabelle1").Cells(2, 1), Workbooks(DateiName).Worksheets("Tabelle1").Cells(Workbooks(DateiName).Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Workbooks(DateiName).Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy ThisWorkbook.Worksheets(Mid(DateiName, 1, Len(DateiName) - 4)).Range("A" & ThisWorkbook.Worksheets(Mid(DateiName, 1, Len(DateiName) - 4)).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
Else
Workbooks(DateiName).Worksheets("Tabelle1").Range(Workbooks(DateiName).Worksheets("Tabelle1").Cells(2, 1), Workbooks(DateiName).Worksheets("Tabelle1").Cells(Workbooks(DateiName).Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Workbooks(DateiName).Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy ThisWorkbook.Worksheets(Mid(DateiName, 1, Len(DateiName) - 4)).Range("A" & ThisWorkbook.Worksheets(Mid(DateiName, 1, Len(DateiName) - 4)).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
End If
End If
Next Dateien
End If
End With
ThisWorkbook.Worksheets(Array("Tabelle1", "Tabelle2", "Tabelle3")).Delete
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Public Function SheetExists(strName As String) As Boolean
On Error Resume Next
SheetExists = Not ThisWorkbook.Worksheets(strName) Is Nothing
End Function
Antwort 5 von morpheus__85
Hallo Leute,
ich habe das selbe Problem wie oben beschrieben.
Ich hab das Makro von gast123 einmal ausprobiert.
meine frage:
wie müsste ich das makro denn abändern, wenn ich die Tabellenblätter nicht in eine neue Mappe einzeln haben möchte sondern den Inhalt in EINE Excelmappe?
hoffe ihr könnt mir helfen.
gruß
morpheus
ich habe das selbe Problem wie oben beschrieben.
Ich hab das Makro von gast123 einmal ausprobiert.
meine frage:
wie müsste ich das makro denn abändern, wenn ich die Tabellenblätter nicht in eine neue Mappe einzeln haben möchte sondern den Inhalt in EINE Excelmappe?
hoffe ihr könnt mir helfen.
gruß
morpheus
Antwort 6 von Saarbauer
Hallo,
versuch es mal mit meinem Makro und ersetze "Zusammenstellung" durch den Namen deines Tabellenblattes
Gruß
Helmut
p.S. du solltest in Zukunft einen eigenen Thread eröffnen, da auch wenn dein Problem fast gleich ist, gewisse differenzen gibt und auf zwei Anfragen in einem Thread zu antworten, bringt immer Probleme.
versuch es mal mit meinem Makro und ersetze "Zusammenstellung" durch den Namen deines Tabellenblattes
Gruß
Helmut
p.S. du solltest in Zukunft einen eigenen Thread eröffnen, da auch wenn dein Problem fast gleich ist, gewisse differenzen gibt und auf zwei Anfragen in einem Thread zu antworten, bringt immer Probleme.
Antwort 7 von gast123
hi morpheus
gruss gast123
diese angaben sollten angepass werden
"C:\Temp\" ist das auszulesende verzeichnis
("Tabelle2") wird ausgelesen
("Tabelle1") wird geschrieben
gruss gast123
diese angaben sollten angepass werden
"C:\Temp\" ist das auszulesende verzeichnis
("Tabelle2") wird ausgelesen
("Tabelle1") wird geschrieben
Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
With Application.FileSearch
.NewSearch
.LookIn = "C:\Temp\"
.Filename = "*.xls"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
If DateiName <> ThisWorkbook.Name Then
Workbooks.Open Filename:=.FoundFiles(Dateien)
Workbooks(DateiName).Worksheets("Tabelle2").Range(Workbooks(DateiName).Worksheets("Tabelle2").Cells(2, 1), Workbooks(DateiName).Worksheets("Tabelle2").Cells(Workbooks(DateiName).Worksheets("Tabelle2").UsedRange.SpecialCells(xlCellTypeLastCell).Row, Workbooks(DateiName).Worksheets("Tabelle2").UsedRange.SpecialCells(xlCellTypeLastCell).Column)).Copy ThisWorkbook.Worksheets("Tabelle1").Range("A" & ThisWorkbook.Worksheets("Tabelle1").UsedRange.SpecialCells(xlCellTypeLastCell).Row + 1)
Workbooks(DateiName).Close SaveChanges:=True
End If
Next Dateien
End If
End With
Call EventsOn
End Sub
Public Sub EventsOff()
With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub
Public Sub EventsOn()
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
Antwort 8 von Cerrio
Hallo zusammen!
erstmal vielen dank für die rege Betelgung und Eure Mühen, leider bin ich ein absoluter Anfänger und kapiere nichts. habe alle geposteten codes ausprobiert, aber es läuft nicht. beim letzten von gast 123 kam fehlermeldung.
"Laufzeitfehler '445': Objekt unterstützt diese Aktion nicht"
Was mach ich nur falsch?
Gruß Cerrio
erstmal vielen dank für die rege Betelgung und Eure Mühen, leider bin ich ein absoluter Anfänger und kapiere nichts. habe alle geposteten codes ausprobiert, aber es läuft nicht. beim letzten von gast 123 kam fehlermeldung.
"Laufzeitfehler '445': Objekt unterstützt diese Aktion nicht"
Was mach ich nur falsch?
Gruß Cerrio
Antwort 9 von morpheus__85
Hallo Leute
erstmal vielen danke an dich gast 123
hast mir echt total geholfen und das makro läuft prima.
@ saarbauer
werd ich das nächste mal machen im nachhinein hast du wirklich recht dachte nur zuerst das passt zum thema und ich mach ma lieber keinen extra thread auf aber eig ist es schon besser weil es auch übersichtlicher is.
danke an euch
gruß
morpheus
erstmal vielen danke an dich gast 123
hast mir echt total geholfen und das makro läuft prima.
@ saarbauer
werd ich das nächste mal machen im nachhinein hast du wirklich recht dachte nur zuerst das passt zum thema und ich mach ma lieber keinen extra thread auf aber eig ist es schon besser weil es auch übersichtlicher is.
danke an euch
gruß
morpheus
Antwort 10 von gast123
hi Cerrio :-)
du machst nichts fasch denk ich mal :-))
geschuetzte bereiche oder verbundene zellen vermute ich mal
wobei geschuetzte bereiche da kein problem waeren
verbundene zellen aber sind der feind eines jeden makros
daher info !!!!
excel7 ist ausgeschlossen
gruss gast123
du machst nichts fasch denk ich mal :-))
geschuetzte bereiche oder verbundene zellen vermute ich mal
wobei geschuetzte bereiche da kein problem waeren
verbundene zellen aber sind der feind eines jeden makros
daher info !!!!
excel7 ist ausgeschlossen
gruss gast123
Antwort 11 von Cerrio
Hallo Gast123!
ja, ich habe viele verbundene zellen und nutze excel 2007... anscheinend liegt es doch an mir ;-)
ja, ich habe viele verbundene zellen und nutze excel 2007... anscheinend liegt es doch an mir ;-)
Antwort 12 von gast123
hi Cerrio :-)
dann sind andere user gefragt,da ich kein excel7 habe.
im vorfeld solltest du deine verbundenen zellen verbannen,es gibt genuegend andere alternativen
gruss gast123
dann sind andere user gefragt,da ich kein excel7 habe.
im vorfeld solltest du deine verbundenen zellen verbannen,es gibt genuegend andere alternativen
gruss gast123