[prakeis]

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").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