Samme sætte en streng når der gemmes 😊

Option Explicit

Dim Wb As Workbook, Ws As Worksheet
Dim CellA As Range, CellB As Range
Dim sTekst As String
Dim FilNavn As String

Sub Gem_Fil()
    Set Wb = ThisWorkbook
    Set Ws = Sheets("Kørselsrapport 1_2")
    Set CellA = Ws.Range("A3")
    Set CellB = Ws.Range("B3")
    FilNavn = Wb.Path & "\Uge_" & Mid(CellB, InStr(11, CellB, ".") + 1)
    FilNavn = FilNavn & "_" & Left(CellB, InStr(1, CellB, " "))
    FilNavn = FilNavn & "-" & Mid(CellB, InStr(1, CellB, ".") + 1, InStr(1, CellB, "/") - InStr(1, CellB, ".") - 1)
    FilNavn = FilNavn & "-" & Left(CellA, InStr(1, CellA, "/") - 1) & "_"
    If InStr(1, Wb.Name, Mid(FilNavn, Len(Wb.Path) + 2)) = 0 Then
        FilNavn = FilNavn & "1"
    Else
        sTekst = Mid(Mid(Wb.Name, InStr(1, Wb.Name, ".") - 4), InStr(1, Mid(Wb.Name, InStr(1, Wb.Name, ".") - 4), "_") + 1)
        sTekst = Left(sTekst, Len(sTekst) - 5) + 1
        FilNavn = FilNavn & sTekst
    End If
    Application.DisplayAlerts = False
    ' at gemme i xlsx filtypen vil gøre at denne macro ikke gemmes med = du ikke kan gemme versioner med den
    Wb.SaveAs Filename:=FilNavn, FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Application.DisplayAlerts = True
End Sub

Sub gem_Uden_Makroer()
Application.DisplayAlerts = False
Worksheets("Hjælpe Ark").Range("B23") = Worksheets("Hjælpe Ark").Range("B23") + 1
ActiveWorkbook.Save

    ActiveWorkbook.SaveAs Filename:= _
    Worksheets("Hjælpe Ark").Range("B25"), _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled

Application.DisplayAlerts = True
End Sub