Création d'un nouveau classeur dans un nouveau dossier

Bonjour à tous!!

Je me débrouille généralement en vba mais surtout via des recherche sur des forum ou vidéo youtube...

Puisque je ne trouve pas réponse à mon problème, je fais appel à vous!

Premièrement, j'ai créé un code VBA permettant de copier les informations du client que je dois inscrire dans le tableau de l'onglet "Nouveau Client" (nom, prenom, adresse etc...) Il copie aussi le "Template" de la soumission et de la facture et aussi la base de donnés qui sert à remplir la soumission avec des listes autorisés...

Ensuite, ceci génère un nouveau classeur excel avec c'est information réuni!

Mon problème:

- J'aimerais pouvoir ajouter dans ce code l'enregistrement automatique de ce classeur dans un nouveau dossier ayant comme titre la combinaison des cellules suivantes:

("Nouveau Client").Range("B2:B4") soit le nom de famille, le prénom et le code client...

Direction pour la création du dossier et l'enregistrement du nouveau classeur: C:\Users\Steve\Dropbox (Ultime Paysagiste)\Ultime Paysagiste\Administration entreprise\Dossier client\

Je ne sais pas si c'est possible via une fonction Mkdir ou autre mais bon... Ce serait la classe !!

J'ai joint le fichier en annexe... Le bouton macro se trouve dans la feuille "Nouveau Client" et c'est le deuxième bouton...

Le VBA se trouve dans le module 3.

Merci d'avance

Voici le code initial demandent ajustement:

Sub Bouton3_Cliquer()

If Worksheets("Nouveau Client").Cells(4, 2) = "" Then

MsgBox "Il faut créer une fiche client"

Else

reponse = MsgBox("La fiche client a été transféré à la base de données?", vbYesNo + vbQuestion, "Créer le dossier Client")

If reponse = vbYes Then

Worksheets("Nouveau Client").Range("B1:B3").Copy

Worksheets("Fiche Client").Range("B1:B3").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B4").Copy

Worksheets("Fiche Client").Range("B4").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B5:B12").Copy

ActiveSheet.Paste Destination:=Worksheets("Fiche Client").Range("B5:B12")

Worksheets("Nouveau Client").Range("B13").Copy

Worksheets("Fiche Client").Range("B13").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B14:B30").Copy

ActiveSheet.Paste Destination:=Worksheets("Fiche Client").Range("B14:B30")

Worksheets(Array("Base Donnés", "Modele Facture", "Soumission Paysager", "Soumission Menuiserie", "Fiche Client")).Copy

With ActiveWorkbook

End With

Else

End If

End If

End Sub

bonjour!

Pour faire court, j'aimerait faire tout ceci en une macro et bien sure que le fichier s'enregistre dans le nouveau dossier créé....

Je ne suis pas assez alaise avec le VBA pour y parvenir si vous voulez bien m'aider!

Merci beaucoup de votre temps

Sub Bouton3_Cliquer()

If Worksheets("Nouveau Client").Cells(4, 2) = "" Then

MsgBox "Il faut créer une fiche client"

Else

reponse = MsgBox("La fiche client a été transféré à la base de données?", vbYesNo + vbQuestion, "Créer le dossier Client")

If reponse = vbYes Then

Worksheets("Nouveau Client").Range("B1:B3").Copy

Worksheets("Fiche Client").Range("B1:B3").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B4").Copy

Worksheets("Fiche Client").Range("B4").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B5:B12").Copy

ActiveSheet.Paste Destination:=Worksheets("Fiche Client").Range("B5:B12")

Worksheets("Nouveau Client").Range("B13").Copy

Worksheets("Fiche Client").Range("B13").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B14:B30").Copy

ActiveSheet.Paste Destination:=Worksheets("Fiche Client").Range("B14:B30")

Worksheets(Array("Base Donnés", "Modele Facture", "Soumission Paysager", "Soumission Menuiserie", "Fiche Client")).Copy

With ActiveWorkbook

End With

Else

End If

End If

End Sub

Sub creer_dossier()

Dim chemin_du_dossier As String

Dim NomDossier As String

NomDossier = Sheets("Fiche Client").Range("B2") & " " & Range("B3") & " " & Range("B4")

'identifier le chemin du dossier

chemin_du_dossier = "C:\Users\Steve\Dropbox...\" & NomDossier

'tester existence

If Dir(chemin_du_dossier, vbDirectory) <> vbNullString Then

'dossier existe, faire rien

Else

'si le dossier n'existe pas, le créer

MkDir (chemin_du_dossier)

End If

End Sub

Sub enregisFichier()

Dim NomFichier As String

NomFichier = Sheets("Fiche Client").Range("B2") & " " & Range("B3") & " " & Range("B4")

ActiveWorkbook.SaveAs "C:\Users\Steve\Dropbox...\" & NomFichier

End Sub

J'ai réussi à créer le dossier et enregistrer le classeur dedans en plus de lui donner un nom selon une cellule!!!

Pour ceux qui ont besoin, voici le code:

Sub creer_le_dossier()

Dim chemin_du_dossier As String

Dim NomDossier As String

NomDossier = Sheets("Fiche Client").Range("B2") & " " & Range("B3") & " " & Range("B4")

chemin_du_dossier = "C:\Users\" & NomDossier

MkDir (chemin_du_dossier)

ActiveWorkbook.SaveAs Filename:=chemin_du_dossier & "\" & NomDossier & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

Je ne suis toujours pas capable par-contre de créer une seul macro avec celui-ci et celui la:

Si un guerrier se sent d'attaque, je suis preneur

J'ai essayer de tout les façons de combiner les deux mais p-e que ce n'est pas possible aussi...

T-K... miracle demander ;P

Merci

Sub Bouton3_Cliquer()

If Worksheets("Nouveau Client").Cells(4, 2) = "" Then

MsgBox "Il faut créer une fiche client"

Else

reponse = MsgBox("La fiche client a été transféré à la base de données?", vbYesNo + vbQuestion, "Créer le dossier Client")

If reponse = vbYes Then

Worksheets("Nouveau Client").Range("B1:B3").Copy

Worksheets("Fiche Client").Range("B1:B3").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B4").Copy

Worksheets("Fiche Client").Range("B4").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B5:B12").Copy

ActiveSheet.Paste Destination:=Worksheets("Fiche Client").Range("B5:B12")

Worksheets("Nouveau Client").Range("B13").Copy

Worksheets("Fiche Client").Range("B13").PasteSpecial Paste:=xlPasteValues

Worksheets("Nouveau Client").Range("B14:B30").Copy

ActiveSheet.Paste Destination:=Worksheets("Fiche Client").Range("B14:B30")

Worksheets(Array("Base Donnés", "Modele Facture", "Soumission Paysager", "Soumission Menuiserie", "Fiche Client")).Copy

With ActiveWorkbook

End With

Else

End If

End If

End Sub

Bonjour Trivius et bienvenue,

à tester,

Sub Bouton3_Cliquer()
Dim chemin_du_dossier As String
Dim NomDossier As String
Dim sh1 As Worksheet, sh2 As Worksheet
Dim reponse As String, NomDossier As String, chemin_du_dossier As String

Set sh1 = Worksheets("Nouveau Client")
Set sh2 = Worksheets("Fiche Client")

If sh1.Cells(4, 2) = "" Then
    MsgBox "Il faut créer une fiche client"
Else

    reponse = MsgBox("La fiche client a été transféré à la base de données?", vbYesNo + vbQuestion, "Créer le dossier Client")

    If reponse = vbYes Then

        sh2.Range("B1:B3") = sh1.Range("B1:B3").Value
        sh2.Range("B4") = sh1.Range("B4").Value
        sh2.Range("B5:B12") = sh1.Range("B5:B12").Value
        sh2.Range("B13") = sh1.Range("B13").Value
        sh2.Range("B14:B30") = sh1.Range("B14:B30").Value

        Worksheets(Array("Base Donnés", "Modele Facture", "Soumission Paysager", "Soumission Menuiserie", "Fiche Client")).Copy

    End If
End If

NomDossier = Sheets("Fiche Client").Range("B2") & " " & Range("B3") & " " & Range("B4")
chemin_du_dossier = "C:\Users\" & NomDossier
MkDir (chemin_du_dossier)
ActiveWorkbook.SaveAs Filename:=chemin_du_dossier & "\" & NomDossier & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled
End Sub

Bon et bien j'ai fini par trouver moi-même:

Il manquais seulement d'ajouter:

Worksheets("Fiche Client").Select à la fin du premier code pour rendre la feuille active

ensuite j'ai tout simplement fait une nouvelle macro:

Sub groupe_creer_client()

macro1

macro2

End Sub

voila alors problème résolu !!

Super!!!

Merci i20100 )

Ton code marche très bien!

Bref il est plus propre aussi...

La même erreur se trouvait sur ton code... il manquait tout simplement à ajouter: Worksheets("Fiche Client").Select pour lui dire de prendre les information sur le nouveau classeur créer...

Infiniment merci

Sub Bouton3_Cliquer()

Dim chemin_du_dossier As String

Dim NomDossier As String

Dim sh1 As Worksheet, sh2 As Worksheet

Dim reponse As String

Set sh1 = Worksheets("Nouveau Client")

Set sh2 = Worksheets("Fiche Client")

If sh1.Cells(4, 2) = "" Then

MsgBox "Il faut créer une fiche client"

Else

reponse = MsgBox("La fiche client a été transféré à la base de données?", vbYesNo + vbQuestion, "Créer le dossier Client")

If reponse = vbYes Then

sh2.Range("B1:B3") = sh1.Range("B1:B3").Value

sh2.Range("B4") = sh1.Range("B4").Value

sh2.Range("B5:B12") = sh1.Range("B5:B12").Value

sh2.Range("B13") = sh1.Range("B13").Value

sh2.Range("B14:B30") = sh1.Range("B14:B30").Value

Worksheets(Array("Base Donnés", "Modele Facture", "Soumission Paysager", "Soumission Menuiserie", "Fiche Client")).Copy

Worksheets("Fiche Client").Select

End If

End If

NomDossier = Sheets("Fiche Client").Range("B2") & " " & Range("B3") & " " & Range("B4")

chemin_du_dossier = "C:\Users\" & NomDossier

MkDir (chemin_du_dossier)

ActiveWorkbook.SaveAs Filename:=chemin_du_dossier & "\" & NomDossier & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

End Sub

Trivius a écrit :

La même erreur se trouvait sur ton code... il manquait tout simplement à ajouter: Worksheets("Fiche Client").Select pour lui dire de prendre les information sur le nouveau classeur créer...

Merci Trivius pour ce retour,

avec vba il n'est jamais nécessaire de faire un .Select ...ou presque jamais

il suffit d'indiquer ou se trouve la valeur

With Sheets("Fiche Client")
NomDossier = .Range("B2") & " " & .Range("B3") & " " & .Range("B4")
End With

il n'est pas nécessaire non plus de faire un copier collage spécial valeur

Set sh1 = Worksheets("Nouveau Client")
Set sh2 = Worksheets("Fiche Client")

        sh2.Range("B1:B3") = sh1.Range("B1:B3").Value
        sh2.Range("B4") = sh1.Range("B4").Value
        sh2.Range("B5:B12") = sh1.Range("B5:B12").Value
        sh2.Range("B13") = sh1.Range("B13").Value
        sh2.Range("B14:B30") = sh1.Range("B14:B30").Value

on peut combiner les 2 code précédent de cette façon

Set sh1 = Worksheets("Nouveau Client")
Set sh2 = Worksheets("Fiche Client")

With sh2
    .Range("B1:B3") = sh1.Range("B1:B3").Value
    .Range("B4") = sh1.Range("B4").Value
    .Range("B5:B12") = sh1.Range("B5:B12").Value
    .Range("B13") = sh1.Range("B13").Value
    .Range("B14:B30") = sh1.Range("B14:B30").Value
    NomDossier = .Range("B2") & " " & .Range("B3") & " " & .Range("B4")
End With