exportere en fil i samme navn som importeret

Jeg har 2 makroer

Den første importerer data fra en txt fil som jeg selv kan udpege.
Den anden exporterer data til en fil jeg selv kan bestemme /udpege.

Først kører jeg importmakroen. og laver lidt forskellige ting med de data der er importeret.
Herefter skal dataene igen exporteres. Når jeg gør det skal jeg som nævnt selv udpege den fil jeg skal gemme i.

Da jeg 99% af gangene skal exportere til den samme fil som jg har importeret fra, ville jeg meget gerne have mulighed for at den bare gør automatisk.

F.eks.
Hvis jeg har importeret fra "post.txt" skal den gemme/overskrive denne fil.
Hvis jeg har imporeret fra data.asc skal den gemme i denne fil.

Husk at jeg laver ting med de importerede data inden exporterer igen.

Jeg havde tænkt at man måske kunne læse filnavnet ind i en celle feks celle Q1 og så bruge det navn når der eksporteres igen.

Se minie makroer nedenfor.
Den ene er godt nok tysk, men det er hvad jeg har kunnet finde på nettet :-)



Sub importer_fra_fil()
  Flt = Flt & "Alle filer(*.*),*.*"
    Titel = "Vælg fil, som skal bearbejdes"
    fileToOpen = Application _
    .GetOpenFilename(Flt, , Titel)
  If fileToOpen <> False Then
    Worksheets("ARK1").Activate
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & fileToOpen, Destination _
        :=Range("A1"))
        .Name = "ARK1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    End If
   
End Sub


*****************************'
Sub SaveCSV()


Dim Bereich As Object, Zeile As Object, Celle As Object
Dim strTemp As String
Dim strDateiname As String
Dim strTrennzeichen As String
Dim strMappenpfad As String

strMappenpfad = ActiveWorkbook.FullName
strMappenpfad = Replace(strMappenpfad, ".xls", ".csv")

strDateiname = Application.GetSaveAsFilename(FileFilter:="Alle filer(*.*), *.csv")
If CSVFilename = "False" Then Exit Sub

strTrennzeichen = InputBox("Hvilken seperator skal der bruges?", "CSV", ",")
If strTrennzeichen = "" Then Exit Sub

Set Bereich = ActiveSheet.UsedRange

Open strDateiname For Output As #1

For Each Zeile In Bereich.Rows
For Each Zelle In Zeile.Cells
If InStr(1, Zelle.Text, strTrennzeichen) > 0 Then
'Zellen, die ein Trennzeichen beinhalten in Anführungsstriche setzen
strTemp = strTemp & """" & CStr(Zelle.Text) & """" & strTrennzeichen
Else
strTemp = strTemp & CStr(Zelle.Text) & strTrennzeichen
End If
Next
If Right(strTemp, 1) = strTrennzeichen Then strTemp = Left(strTemp, Len(strTemp) - 1)
Print #1, strTemp
strTemp = ""
Next

Close #1
Set Bereich = Nothing
MsgBox "Filen er nu exporteret som en kommafil med navn:" & vbCrLf & strDateiname

End Sub