Mehrere Excel ToDo Listen per VBA bzw Makro zusammenführen? Teil 2
Erbitte Unterstützung bei der Anpassung eines Excel Makros
Hallo zusammen,
auf der Suche nach einem Makro, mit dem ich mehrere Excel-Listen per Makro zusammenführen kann, bin ich auf folgenden Beitrag gestoßen:
Mehrere Excel ToDo Listen per VBA bzw Makro zusammenführen?
Option Explicit
Const HomeDatei = "LeereArbeitsmappe.xls" 'Name Arbeitsmappe Makro-Excel-Datei
Const HomeDaten = "Daten-Import" 'Name Tabellenblatt Daten-Import
Const HomeListe = "Datei-Liste" 'Name Tabellenblatt Datei-Liste
Const HomeZeile = 3 'Erste Zeile Einfügen
Const CopyZeile = 3 'Erste Zeile Kopieren
Const ListDatei = "A1" 'Zelle erster Dateiname
Const ErrMsg = "Abbruch! Datei existiert nicht: "
Sub SheetsImport()
Dim WksHome As Worksheet, WksList As Worksheet, EndLine As Integer, NextLine As Integer
Dim WkbCopy As Workbook, WksCopy As Worksheet, Fso As Object, File As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WksHome = Workbooks(HomeDatei).Sheets(HomeDaten)
Set WksList = Workbooks(HomeDatei).Sheets(HomeListe)
EndLine = GetEndLine(WksHome): NextLine = HomeZeile
If EndLine >= HomeZeile Then WksHome.Rows("3:" & EndLine).Cells.Clear
Application.ScreenUpdating = False
For Each File In WksList.Range(ListDatei).CurrentRegion
If Fso.FileExists(File) = False Then
Application.ScreenUpdating = True
MsgBox ErrMsg & File, vbExclamation, "Fehler": Exit Sub
End If
Set WkbCopy = Workbooks.Open(File): Set WksCopy = WkbCopy.Sheets(1)
EndLine = GetEndLine(WksCopy)
If EndLine >= CopyZeile Then
WksCopy.Rows("3:" & EndLine).Copy
WksHome.Rows(NextLine).Insert Shift:=xlDown
Application.CutCopyMode = False
WkbCopy.Saved = True: WkbCopy.Close
NextLine = GetEndLine(WksHome) + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Private Function GetEndLine(ByRef Wks) As Integer
GetEndLine = Wks.Cells(Wks.Rows.Count, "A").End(xlUp).Row
End Function
Wäre nun auch möglich, als Quelle keine einzelnen Excel-Dateien anzugeben, sondern lediglich ein Verzeichnis, in welchem die Dateien liegen und das Makro einfach alle verarbeiten soll?
Könnte man das o.g. Makro dementsprechend abändern?
Vielen Dank vorab für eure Unterstützung!
Viele Grüße,
L.
auf der Suche nach einem Makro, mit dem ich mehrere Excel-Listen per Makro zusammenführen kann, bin ich auf folgenden Beitrag gestoßen:
Mehrere Excel ToDo Listen per VBA bzw Makro zusammenführen?
Option Explicit
Const HomeDatei = "LeereArbeitsmappe.xls" 'Name Arbeitsmappe Makro-Excel-Datei
Const HomeDaten = "Daten-Import" 'Name Tabellenblatt Daten-Import
Const HomeListe = "Datei-Liste" 'Name Tabellenblatt Datei-Liste
Const HomeZeile = 3 'Erste Zeile Einfügen
Const CopyZeile = 3 'Erste Zeile Kopieren
Const ListDatei = "A1" 'Zelle erster Dateiname
Const ErrMsg = "Abbruch! Datei existiert nicht: "
Sub SheetsImport()
Dim WksHome As Worksheet, WksList As Worksheet, EndLine As Integer, NextLine As Integer
Dim WkbCopy As Workbook, WksCopy As Worksheet, Fso As Object, File As Object
Set Fso = CreateObject("Scripting.FileSystemObject")
Set WksHome = Workbooks(HomeDatei).Sheets(HomeDaten)
Set WksList = Workbooks(HomeDatei).Sheets(HomeListe)
EndLine = GetEndLine(WksHome): NextLine = HomeZeile
If EndLine >= HomeZeile Then WksHome.Rows("3:" & EndLine).Cells.Clear
Application.ScreenUpdating = False
For Each File In WksList.Range(ListDatei).CurrentRegion
If Fso.FileExists(File) = False Then
Application.ScreenUpdating = True
MsgBox ErrMsg & File, vbExclamation, "Fehler": Exit Sub
End If
Set WkbCopy = Workbooks.Open(File): Set WksCopy = WkbCopy.Sheets(1)
EndLine = GetEndLine(WksCopy)
If EndLine >= CopyZeile Then
WksCopy.Rows("3:" & EndLine).Copy
WksHome.Rows(NextLine).Insert Shift:=xlDown
Application.CutCopyMode = False
WkbCopy.Saved = True: WkbCopy.Close
NextLine = GetEndLine(WksHome) + 1
End If
Next
Application.ScreenUpdating = True
End Sub
Private Function GetEndLine(ByRef Wks) As Integer
GetEndLine = Wks.Cells(Wks.Rows.Count, "A").End(xlUp).Row
End Function
Wäre nun auch möglich, als Quelle keine einzelnen Excel-Dateien anzugeben, sondern lediglich ein Verzeichnis, in welchem die Dateien liegen und das Makro einfach alle verarbeiten soll?
Könnte man das o.g. Makro dementsprechend abändern?
Vielen Dank vorab für eure Unterstützung!
Viele Grüße,
L.
Please also mark the comments that contributed to the solution of the article
Content-Key: 184997
Url: https://administrator.de/contentid/184997
Printed on: April 25, 2024 at 22:04 o'clock
2 Comments
Latest comment
Hallo Mr-Lanzelot!
Grüße
bastla
P.S.: In der Nachbarschaft: Sammeltabelle - Daten (Zeilen) aus einem Ordner welcher über 300 Tabellen verfügt in einer Tabelle sammeln.
Wäre nun auch möglich, als Quelle keine einzelnen Excel-Dateien anzugeben, sondern lediglich ein Verzeichnis, in welchem die Dateien liegen und das Makro einfach alle verarbeiten soll?
Ja.Könnte man das o.g. Makro dementsprechend abändern?
Ja.Grüße
bastla
P.S.: In der Nachbarschaft: Sammeltabelle - Daten (Zeilen) aus einem Ordner welcher über 300 Tabellen verfügt in einer Tabelle sammeln.