Bruge værdien i en celle til at bestemme en sti

Du kan nok bruge en makro der kalder en funktion.

Makroen rettet til så din sti passer. Du må selv passe resten til, det kan nok betale sig at dele makroen, f.eks. en makro der vælger området der skal kopieres, opretter nyt ark, sætter ind og derefter kalder min makro (Call GemSom). Slut min makro med at skifte til det ark du ønsker.

Her er  makroen:

Sub GemSom()
    On Error GoTo Err1
    With Sheets("Ark1")
        ActiveWorkbook.SaveAs CheckMakePath("P:\Kalkulation_døre\" & Sheets("Ark1").Range("BI3").Text & _
        "\" & Sheets("Ark1").Range("BL3").Text  & ".xls"
    End With
    MsgBox "                Regnskabet er gemt" + Chr(10) + "i den ønskede mappe"
    Exit Sub
Err1:
    MsgBox "Der opstod en fejl." + Chr(10) + "'Gem'-handlingen blev annulleret.", vbExclamation, ""
    Exit Sub
End Sub

Og her er den funktion den kalder (CheckMakePath):

Function CheckMakePath(ByVal vPath As String) As String
    Dim PathSep As Long, oPS As Long
    If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
    PathSep = InStr(3, vPath, "\")
    If PathSep = 0 Then Exit Function
    Do
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
        If PathSep = 0 Then Exit Do
        If Len(Dir(Left(vPath, PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until PathSep = 0
        MkDir Left(vPath, PathSep)
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
    Loop
    CheckMakePath = vPath
End Function

Den tjekker om stien eksisterer, hvis ikke bliver den oprettet.

Jeg bruger den selv til at sikre at stien eksisterer på et netværksdrev.

Hej Perhol

Mange tak for hjælpen. Jeg kan dog ikke få det til at spille. Hvor skal jeg placere funktionen?

Jeg har begge dele placeret i et modul.
Du laver et modul i Visual Basic Editor (tryk Alt+F11)

I VBE indsætter du et modul ved at vælge menuen [Insert] punktet [Module].

I det oprettede modul indsætter du både makro og funktion.

Hej Perhol

Min makro en allerede en del af en anden makro (Bliver kaldt frem når en anden makro kører)

Jeg får fejlmeddellelsen Compile error  -  Syntax error

Nedenstående er det module jeg har sat makro og funktion ind i:

Sub opdC5()
'
' opdC5 Makro
' Makro indspillet 21-01-2010
'

'
    Sheets("Exel til C5").Select
    Range("A1:G134").Select
    Selection.Copy
    ActiveWindow.SmallScroll Down:=-75
    Range("A1").Select
    Workbooks.Add
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    With Sheets("Ark1")
        ActiveWorkbook.SaveAs CheckMakePath("P:\Kalkulation_døre\" & Sheets("Ark1").Range("F1").Text & "\" & Sheets("Ark1").Range("G1").Text  & ".xls
        End With
       
    ActiveWindow.Close
    ActiveWindow.SmallScroll Down:=-132
    Range("A1").Select
    Sheets("MH").Select
End Sub

Function CheckMakePath(ByVal vPath As String) As String
    Dim PathSep As Long, oPS As Long
    If Right(vPath, 1) <> "\" Then vPath = vPath & "\"
    PathSep = InStr(3, vPath, "\")
    If PathSep = 0 Then Exit Function
    Do
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
        If PathSep = 0 Then Exit Do
        If Len(Dir(Left(vPath, PathSep), vbDirectory)) = 0 Then Exit Do
    Loop
    Do Until PathSep = 0
        MkDir Left(vPath, PathSep)
        oPS = PathSep
        PathSep = InStr(oPS + 1, vPath, "\")
    Loop
    CheckMakePath = vPath
End Function

Hej perhol

Jeg er kommet til at oprette spørgsmålet 2x, og på det andet spørgsmål har jeg fået hjælpen at lave et parameter

Sti = "P:\Kalkulation_døre\" & Worksheets("Ark1").Range("F1").Text & "\" & Sheets("Ark1").Range("G1").Text & ".xls"
        ActiveWorkbook.SaveAs Sti

Det virker fint

Jeg kan ikke gennemskue, om din funktion vil kunne oprette en mappe, hvis den ikke er oprettet? Kan den det, vil jeg gerne have hjælpen, ellers kan jeg bare bruge ovenstående

På forhånd tak for hjælpen

Funktionen opretter mapper og undermapper hvis de ikke eksisterer.
Der opstår tilsyneladende en konflikt mellem det du allerede har lavet og det ny.
Jeg skal nok se filen for at kunne rede det ud!
Er væk indtil i morgen eftermiddag.

Hej perhol

Jeg vil gerne have den funktion, at en mappe bliver oprettet, hvis den ikke er lavet. Kan du evt. hjælpe

PFT
Ups

Kan du sende mig filen. Evt. i anonymiseret form.
Den skal indeholde al kode din fil normalt indeholder, men data kan være anonymiseret.
Så skal jeg se på det.

Mailadresse i min profil

Hej perhol

mega fil på vej ;-)

Tak fordi du gider kigge på det

MVH
Ups

I makroen GemSom manglede der en højreparentes.
Desuden var der henvisning til forkert ark og celle.
Her er den rettede makro:

Sub GemSom()
    On Error GoTo Err1
    With Sheets("Exel til C5")
        ActiveWorkbook.SaveAs CheckMakePath("P:\Kalkulation_døre\" & Sheets("MH").Range("H2").Text) & _
        "_" & Sheets("MH").Range("F2").Text & ".xls"
        End With
    MsgBox "                Regnskabet er gemt" + Chr(10) + "i den ønskede mappe"
    Exit Sub
Err1:
    MsgBox "Der opstod en fejl." + Chr(10) + "'Gem'-handlingen blev annulleret.", vbExclamation, ""
    Exit Sub
End Sub

Hej Perhol

Tusind tak for hjælpen, de rettelser du har lavet virker perfekt

Smid et svar, og hvis jeg ikke her kan give dig flere point, laver jeg yderlig et spørgsmål så du kan få for fortjeneste

Ups

Et svar :b)