Gruppen

Top Gruppen: Windows 7; Windows Vista; Windows XP; Textverarbeitung; Excel; DSL; Internet Browser; E-Mail/Outlook
Betriebsysteme: Windows classik; Linux; BS-Sonstige
Software: Datenbanken; Bildbearbeitung; Audio/mp3/Video; Security/Viren; SW-Sonstige
Hardware: Mainboard/CPU; Grafikkarten; Peripherie; Laptop/Notebook; HW-Sonstiges
Netzwerk: Telefon,ISDN,Modem; W-Lan; NW-Sonstiges
Programmierung: PHP,ASP,Perl...; Java,C++...; Webseiten/HTML
Sonstiges: PC-Sonstiges; Plauderecke; SN Intern; Test

/ Forum / Tabellenkalkulation

Tabellenkalkulation

Fragevon Cerrio vom 21.01.2020, 16:14 Options

Excel: Tabellenblätter aus Dateien automatisch in eine einzige neue Datei kopieren

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 schreiben

Antwort 1 von Saarbauer vom 21.01.2020, 19:35 Options

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

Antwort 2 von Cerrio vom 22.01.2020, 15:39 Options

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

Antwort 3 von Saarbauer vom 23.01.2020, 11:42 Options

Hallo,

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 vom 23.01.2020, 12:33 Options

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

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 vom 23.01.2020, 14:38 Options

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

Antwort 6 von Saarbauer vom 23.01.2020, 15:48 Options

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.

Antwort 7 von gast123 vom 23.01.2020, 18:33 Options

hi morpheus

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 vom 23.01.2020, 23:39 Options

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

Antwort 9 von morpheus__85 vom 24.01.2020, 10:01 Options

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

Antwort 10 von gast123 vom 24.01.2020, 13:26 Options

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

Antwort 11 von Cerrio vom 24.01.2020, 16:53 Options

Hallo Gast123!

ja, ich habe viele verbundene zellen und nutze excel 2007... anscheinend liegt es doch an mir ;-)

Antwort 12 von gast123 vom 25.01.2020, 09:47 Options

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

Hinweis

Diese Frage ist schon etwas älter, Sie können daher nicht mehr auf sie antworten. Sollte Ihre Frage noch nicht gelöst sein, stellen Sie einfach eine neue Frage im Forum..