Hallo
Ich habe mehre Excel Datei (4 Stück) und in jeder Excel Tabelle existiert 1 Sheet, welches vom Grundaufbau vollkommen identisch sind (nur Daten sind unterschiedlich).
Nun möchte ich gerne das in einer neuen Excel Datei diese 4 Sheets zu einem zusammengefügt werden.
In der ersten Spalte A ist immer eine Art "ID" und in Spalte B immer ein "Datum". Die anderen Spalten können wir erstmal vernachlässigen.
Die Daten sollen erstmal einfach untereinander kopiert werden und dann nach Datum sortiert werden.
Die Tabellen einzeln zu kopieren in jeweils einen unterschiedlichen Sheet geht ja, aber in einem Sheet ohne Leerzeile und dann noch sortieren funktioniert leider nicht.
Hier mal der Code für einzeln kopieren:
Vielen Dank für Eure Hilfe schonmal
Zuordnung der einzelnen Tabellen und deren Zielort:
Ich habe mehre Excel Datei (4 Stück) und in jeder Excel Tabelle existiert 1 Sheet, welches vom Grundaufbau vollkommen identisch sind (nur Daten sind unterschiedlich).
Nun möchte ich gerne das in einer neuen Excel Datei diese 4 Sheets zu einem zusammengefügt werden.
In der ersten Spalte A ist immer eine Art "ID" und in Spalte B immer ein "Datum". Die anderen Spalten können wir erstmal vernachlässigen.
Die Daten sollen erstmal einfach untereinander kopiert werden und dann nach Datum sortiert werden.
Die Tabellen einzeln zu kopieren in jeweils einen unterschiedlichen Sheet geht ja, aber in einem Sheet ohne Leerzeile und dann noch sortieren funktioniert leider nicht.
Hier mal der Code für einzeln kopieren:
Vielen Dank für Eure Hilfe schonmal
Visual Basic-Quellcode
- Private Function Datenkopieren(strPfad As String, strDateiname As String, arrTabellen() As String) As Boolean
- ' Rückgabe ist True, wenn Kopieren erfolgreich, False bei Fehler
- Dim ranBereich As Range
- Dim wbQuelle As Workbook
- Dim wbZiel As Workbook
- Dim wsQuelle As Worksheet
- Dim wsZiel As Worksheet
- fktKopiereDaten = False ' Rückgabewert initialisieren
- On Error GoTo Fehler ' Geordnetes Beenden, wenn z.B. beim Dateiöffnen ein Fehler auftritt
- Application.EnableEvents = False
- Application.ScreenUpdating = False
- ' Ziel = diese Datei
- Set wbZiel = ActiveWorkbook
- ' Quelle = oben angegebene Datei mit Pfad
- Set wbQuelle = Workbooks.Open(Filename:=strPfad + strDateiname, ReadOnly:=True, Editable:=False)
- Dim strTabellenname As Variant
- For Each strTabellenname In arrTabellen
- If strTabellenname = vbNullString Then ' wenn Ende der Liste erreicht, for-Schleife verlassen
- Exit For
- End If
- Set wsZiel = wbZiel.Worksheets(strTabellenname)
- Set wsQuelle = wbQuelle.Worksheets(strTabellenname)
- 'Werte auslesen und übertragen
- 'Debug.Print wsQuelle.Range("A1").SpecialCells(xlCellTypeLastCell).Address
- Set ranBereich = wsQuelle.Range("A2", wsQuelle.Range("A1").SpecialCells(xlCellTypeLastCell).Address)
- ranBereich.Copy Destination:=wsZiel.Range("A2")
- Next
- fktKopiereDaten = True ' alles OK
- Fehler:
- If Not wbQuelle Is Nothing Then
- wbQuelle.Close False
- End If
- Application.ScreenUpdating = True
- Application.EnableEvents = True
- If (fktKopiereDaten = False) Then
- MsgBox "Fehler beim Kopieren aus Datei " & strPfad + strDateiname
- End If
- End Function
Zuordnung der einzelnen Tabellen und deren Zielort:
Visual Basic-Quellcode
- Dim arrTabellen(20) As String ' Liste der zu kopierenden Tabellenblätter
- 'Datei 2
- Erase arrTabellen
- arrTabellen(0) = "Tabelle1"
- ' Kopierfunktion
- fktKopiereDaten "C:\Desktop\", "Datei1.xlsm", arrTabellen
- 'Datei 2
- Erase arrTabellen
- arrTabellen(0) = "Tabelle1"
- ' Kopierfunktion
- fktKopiereDaten "C:\Desktop\", "Datei2.xlsm", arrTabellen
- ......