Thisworkbook .path et sous dossier

Bonjour à tous,

Probleme 1 :Malgré mes recherches, je n'arrive pas à enregistrer ma feuille dans le sous dossier (nom en fonction d'une valeur cellule)

Probleme 2 : quand j'enregistre ma feuille elle écrase la feuille existante...j'ai vu des codes avec recherche de feuille existante et si elle existe que l'on puisse enregistrer en ajoutant & "-" & i

J'ai tenté d'écrire ma macro comme suit:

sChemin = ThisWorkbook.Path & "\" & NomFeuil & "\"

Pourquoi je n'accède pas à mon sous dossier? le sous dossier est choisi en fonction du nom en cellule "C14"

Sub test()

Dim NomFeuil As String, NexistePas As Boolean, Caractere As String

NomFeuil = Range("C14").Value

   sChemin = ThisWorkbook.Path & "\" & NomFeuil & "\"

With ActiveSheet
        .Copy
        With ActiveWorkbook
    Dim ListLiens, i As Long
    ListLiens = ActiveWorkbook.LinkSources
    For i = LBound(ListLiens) To UBound(ListLiens)
        ActiveWorkbook.BreakLink ListLiens(i), xlLinkTypeExcelLinks
    Next i
            .SaveAs Filename:=sChemin & "Commande " & NomFeuil & " - " & Format([D5], "dd-mm-yyyy"), FileFormat:=51 'xlOpenXMLWorkbook
            .Close
        End With
    End With

End Sub

Merci pour votre aide

Bonjour jyconnaisrien

Sub test()

Dim NomFeuil As String, NexistePas As Boolean, Caractere As String
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
NomFeuil =Range("C14").Value

   sChemin = ThisWorkbook.Path & "\" & NomFeuil & "\"
If Not fso.FolderExists(sChemin) Then MsgBox sChemin & " n'existe pas": Exit Sub
    ActiveSheet.Copy

    Dim ListLiens
    ListLiens = ThisWorkbook.LinkSources
    If Not IsEmpty(ListLiens) Then
    Dim i As Long
    For i = LBound(ListLiens) To UBound(ListLiens)
        ActiveWorkbook.BreakLink ListLiens(i), xlLinkTypeExcelLinks
    Next i
            ThisWorkbook.SaveAs Filename:=sChemin & "Commande " & NomFeuil & " - " & Format([D5], "dd-mm-yyyy"), FileFormat:=51 'xlOpenXMLWorkbook
            ThisWorkbook.Close

    End If
End Sub

A Essayer

Cdlt

Bonjour scraper,

Le fichier est crée mais hélas pas enregistré

"sChemin = ThisWorkbook.Path & "\" & NomFeuil & "\"" ne va pas car la nouvelle feuille est bien ouverte mais les liens et macro sont toujours la aussi

apres de multi bidouilles je ne suis pas loin du resultat mais qq petit bug d'enregistrement

Dim sChemin As String, sDossier As String, nom_fichier As String
Dim NomFeuil As String, NexistePas As Boolean, Caractere As String

    'Application.ScreenUpdating = False
    'Application.DisplayAlerts = False
    'Application.EnableEvents = False

    'ActiveSheet.Pictures.Visible = False

    NomFeuil = Range("C14").Text

    sDossier = ThisWorkbook.Path & "\" & NomFeuil
    nom_fichier = sDossier & "\" & NomFeuil

    With ActiveSheet
        .Copy
        With ActiveWorkbook
    Dim ListLiens, i As Long
    ListLiens = ActiveWorkbook.LinkSources
    For i = LBound(ListLiens) To UBound(ListLiens)
        ActiveWorkbook.BreakLink ListLiens(i), xlLinkTypeExcelLinks
    Next i
            .SaveAs Filename:=nom_fichier & "Commande " & NomFeuil & " - " & Format([D5], "dd-mm-yyyy"), FileFormat:=51 'xlOpenXMLWorkbook
            .Close
        End With
    End With

    'ActiveSheet.Pictures.Visible = True

    ThisWorkbook.Close

    'Application.EnableEvents = True
   'Application.DisplayAlerts = True
   'Application.ScreenUpdating = True

J'obtiens enfin ce que je souhaite avec ce fameux chemin que j'ai décomposé en 2 temps:

        sDossier = ThisWorkbook.Path & "\" & "Nomfeuil"
        nom_fichier = sDossier & "\" & "NomFeuil"

Je vous poste ce que j'ai finalement réussi à macronifier

Dim sChemin As String, sDossier As String, nom_fichier As String
Dim NomFeuil As String, NexistePas As Boolean, Caractere As String
Dim ListLiens, i As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False

        ActiveSheet.Pictures.Visible = False

        NomFeuil = Range("C14").Text

        sDossier = ThisWorkbook.Path & "\" & NomFeuil
        nom_fichier = sDossier & "\" & "Commande " & NomFeuil

        With ActiveSheet
            .Copy
            With ActiveWorkbook

            ListLiens = ActiveWorkbook.LinkSources
            For i = LBound(ListLiens) To UBound(ListLiens)
                ActiveWorkbook.BreakLink ListLiens(i), xlLinkTypeExcelLinks
            Next i
                .SaveAs Filename:=nom_fichier & " - " & Format([D5], "dd-mm-yyyy"), FileFormat:=51  'xlOpenXMLWorkbook
                .Close
            End With
        End With

        ActiveSheet.Pictures.Visible = True

   Application.EnableEvents = True
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True