Modif macro impression - ajout d'un répertoire dans chemin

Bonjour à toutes et tous.

Qui pourrait me modifier cette macro pour qu'elle enregistre le fichier dans un sous répertoire reprenant la valeur de" B2" (nom_client) pour obtenir :

"D:\Mes Documents\nom_client\........(Fich).xls"

Merciiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiiii ii.................

PS : cette macro a été trouvée sur le net et je sais plus où.... d'où ma demande.

Sub Enregistrement01()

Dim Rep As String, Fich As String, C As Byte, Cancel, Q As String

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Rep = "D:\Mes Documents\"

With ActiveWorkbook

Fich = Range("B2") & "_" & "_" & Range("C2") & "_" & "_" & Range("D1")

For C = 1 To Len(Fich) 'test caractères interdits

If InStr("\/:*?""""<>|", Mid(Fich, C, 1)) > 0 Then

MsgBox "Attention, il y a des des caractères interdits !"

Cancel = True

Exit Sub

End If

Next

If dir(Rep & Fich & ".xls") <> "" Then 'test existence fichier

Q = MsgBox(Fich & " Existe déjà, voulez-vous le remplacer ?", vbYesNo)

If Q = 7 Then GoTo Ligne1 Else GoTo Ligne2

Else: GoTo Ligne2

End If

Ligne1:

Cancel = True

Exit Sub

Ligne2:

.SaveAs Rep & Fich & ".xls"

End With

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

Bonsoir, je te propose cette version

Les fichiers sont enregistré dans "D:\mes documents", le sous-répertoire doit être spécifié en B2 et le nom de fichier en C2

Cordialement

Sub Enregistrement01()

Dim Rep As String, Fich As String, C As Byte, Cancel As Boolean, Q As Byte
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Rep = "D:\Mes Documents\"
'Nom du répertoire en B2
'Nom du fichier en C2
Fich = Range("B2")
For C = 1 To Len(Fich) 'test caractères interdits dans le nom du répertoire
    If InStr("\/:*?""""<>|", Mid(Fich, C, 1)) > 0 Then
        MsgBox "Attention, il y a des des caractères interdits dans le nom du répertoire!"
        Cancel = True
        Exit For
    End If
Next
If Not Cancel Then
    Rep = Rep & Fich & "\"
    Fich = Range("C2")
    For C = 1 To Len(Fich) 'test caractères interdits dans le nom du fichier
        If InStr("\/:*?""""<>|", Mid(Fich, C, 1)) > 0 Then
            MsgBox "Attention, il y a des des caractères interdits dans le nom du fichier!"
            Cancel = True
            Exit For
        End If
    Next
    If Not Cancel Then
        If Dir(Rep & Fich & ".xls") <> "" Then 'test existence fichier
            Q = MsgBox(Fich & " Existe déjà, voulez-vous le remplacer ?", vbYesNo)
        End If
        If Q = 7 Then Cancel = True
        If Not Cancel Then ActiveWorkbook.SaveAs Rep & Fich & ".xls"
    End If
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Un grand merci je vais tester cela de suite..... Merciiiiii