Danke vielmal hab es nun geschafft nur hab ich jetzt das Problem das nicht UTF-8 files gemacht werden sondern UTF-8-BOM, die Files können zwar gelesen werden aber mache einige Probleme...

Hier der Aktuellste Code den ich habe wo die Files in UTF-8-BOM gespeichert werden:

Public Sub import()
Dim objStream, strData
Dim Spalte As Long
Dim strPfad As String
Dim strDatei As String
Dim strOrdner As String
Dim strEndung As String
Dim Auftragnummer As String
Dim intr1 As Integer, intr2 As Integer, Suchspalte As Integer



Spalte = 2
strPfad = Range("J1")
strEndung = Range("J2")
strOrdner = "\" & Range("J3") & "\"

'Prüfen ob Ordner da ist wenn nicht erzeugen
If Dir(strPfad & strOrdner, vbDirectory) = "" Then
  MkDir (strPfad & strOrdner)
End If

'Prüfen ob Text 2x vorkommt

Suchspalte = 4
For intr1 = 1 To Cells(Rows.Count, 4).End(xlUp).Row
    For intr2 = intr1 + 1 To Cells(Rows.Count, 4).End(xlUp).Row
        If Cells(intr1, Suchspalte) = Cells(intr2, Suchspalte) Then
            MsgBox Cells(intr1, Suchspalte).Value & " ist doppelt vorhanden (Zeile" & intr1 & " und " & intr2 & " Es werden keine Dateien erzeugt, da diese sonst überschrieben werden! Bitte Doppelte Einträge korrigieren!"
        Exit Sub
        End If
    Next intr2
Next intr1

Do While Cells(Spalte, 1).Value <> ""
strDatei = Range("D" & Spalte)

'Textdatei auslesen
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.LoadFromFile ("E:\Eigene Dateien\muster.GEO")
strData = objStream.ReadText()


'Suchen und ersetzen
strData = Replace(strData, "laenge", Range("A" & Spalte))

strData = Replace(strData, "breite", Range("B" & Spalte))

strData = Replace(strData, "anzahll", Range("E" & Spalte))

strData = Replace(strData, "lochx", Range("F" & Spalte))

strData = Replace(strData, "lochy", Range("G" & Spalte))
        
strData = Replace(strData, "mmquad", Range("C" & Spalte))




'Speichern
Set objStream = CreateObject("ADODB.Stream")
objStream.Charset = "utf-8"
objStream.Open
objStream.WriteText strData
objStream.SaveToFile strPfad & strOrdner & strDatei & strEndung, 2
objStream.Close

Spalte = Spalte + 1
Loop
End Sub