Datein aus Ordner auslesen aber vorher für jede Datei ein Makro ausführen

[llotS]

Hallo schauan,

danke für deine Hilfe - für das hinzufügen einer neuen Tabelle komme ich mit dem Rekorder auf dieses Makro (recht simpel, ja ^^)

Code:

Sub AddSheet()

    Sheets.Add After:=ActiveSheet
    Sheets("Tabelle1").Select
    Sheets("Tabelle1").Name = "SUM"

End Sub

Jetzt Frage ich mich natürlich, wie ich die Formeln auf das "SUM" Tabellen-Blatt bekomme, wenn ich die benötigen Formeln in die "Auswertungs-Datei" schreibe und von dort aus in jede "Lese-Datei" Ad-hoc kopiere und noch einmal ein "suchen-ersetzen" drüberlaufen lasse bevor ich die Daten für die Auswertung auslese sollte dies aber eigentlich funktionieren.

Code:

Sub Add_Formula()

    Windows("Auswertungs_Datei_v2.xlsm").Activate
    Sheets("AUSWERTUNGS_FORMLEN").Select
    Cells.Select
    Selection.Copy
    Windows("Lese_Datei1.xlsx").Activate
    Cells.Select
    ActiveSheet.Paste
    Range("B2").Select
    Application.CutCopyMode = False
    Cells.Select
    Range("B2").Activate
    Selection.Replace What:="[Auswertungs_Datei_v2.xlsm]", Replacement:="", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
    Windows("Auswertungs_Datei_v2.xlsm").Activate
    Application.WindowState = xlMinimized
End Sub

Ich bin mir jetzt nur nicht sicher ob bzw. wo ich die beiden oben genannten codes in mein aktuelles Makro mit einbauen kann:

Code:

Sub GrabData()
    On Error Resume Next
    Const PFAD = "C:\files" 'Pfad der auszulesenden Dateien
    Dim ws As Worksheet, rngZiel As Range, f As String
    Set ws = Sheets("Daten1") 'Tabellenname in die ich reinschreiben möchte
    ws.Range("2:1048576").Clear 'Tabelle vorher leeren
    Set rngZiel = ws.Range("A2") 'ab wo ich die Dateien einfügen möchte
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    f = Dir(PFAD & "\*.xlsx")
    While f <> ""
        With GetObject(PFAD & "\" & f).Sheets("SUM") 'aus welchem Tabellenblatt ich auslesen möchte
            .Range("B2:XFD2").Copy 'welche Zeile ich rauskopieren möchte
            rngZiel.PasteSpecial xlPasteValuesAndNumberFormats
            .Parent.Close False
        End With
        Set rngZiel = rngZiel.Offset(1, 0)
        f = Dir
    Wend
        Range("A1").Select
    ActiveCell.FormulaR1C1 = "=NOW()" 'Amateurhaftes einfügen eines Datums
    Range("A1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Alle Datein wurden importiert!"
End Sub

Angehangen auch noch einmal die akuellen EXCEL Dateien.

Vielen Dank für eure Hilfe!

[shift-del]

Moin

Hier mal meine PQ-Lösung. War nicht so einfach wegen der *** Datenstruktur.
Die ersten beiden Schritte musst du auf deine Gegebenheiten anpassen.