Hallo und Guten Morgen,

Folgendes Problem: Ich habe ein Makro, welches mir automatisch mit folgenden Schritten die arbeit erleichtern soll.

1. vom aktuellen blatt weiter springen

2. ziffern aus einem Dateinamen einfügen

3. diese Ziffern in den Blattnamen kopieren

4. neuen Blattnamen kopieren und nach einer Datei mit dem Namen suchen

5. Dateiinhalt einfügen.

usw.....

Funktioniert auf dem angegebenen Blatt wunderbar. Da aber alle Blätter (30 -31) ausgefüllt werden sollen, brauche ich einen allgemeinen Buzug auf die Zelle mit dem Dateinamen und einen allgemeinen Bezug auf den Blattnamen. Auch nach der allgmeinen suche der Text-Datei müsste was allgmeines stehen.

Das Makro :

ActiveSheet.Next.Select
    Range("K1").Select
    ActiveCell.FormulaR1C1 = _
        "=MID(CELL(""Dateiname""),FIND(""]"",CELL(""Dateiname""))-11,6)"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "201505"
    Range("K1").Select
    Selection.Copy
    Sheets("05").Select
    Sheets("05").Name = "20150505"
    Range("A2").Select
    Sheets("20150505").Select
    Application.CutCopyMode = False
    Sheets("20150505").Name = "20150505"
    Range("K1").Select
    ActiveSheet.Select
    ActiveCell.FormulaR1C1 = "20150505"
    Range("A2").Select
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;I:\Teile_20150505.txt", _
        Destination:=Range("$A$2"))
        .Name = "Teile_20150526"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Range("A1:H1").Select
    Selection.AutoFilter
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
    Columns("D:D").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").EntireColumn.AutoFit
    Columns("G:G").EntireColumn.AutoFit
    Columns("H:H").EntireColumn.AutoFit
    Range("K1").Select
    Selection.ClearContents
    Range("A2").Select
   
   
End Sub

Ich habe die Werte dick makiert, welche ersetzt werden müssen.

Ziel ist es, das mir das Makro auf allen 30 - 31 Blättern die passende Textdatei einfügt, ich das Makro kopieren kann und in eine neue Datei für den nächsten Monat  einfügen kann.

Vielen Dank für die Hilfe schonmal.

Lg Heiko