créer un dossier puis un fichier dans le dossier via VBA

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
J

jujunexcelpas

XLDnaute Nouveau
Bonjour le forum,
je suis dans une impasse, avec votre aide une macro a été créée et je souhaiterai ajouter une étape pour son bon fonctionnement!
la macro crée un fichier dans un dossier cible, et je souhaiterai que celle ci crée un dossier nominatif dans lequel ira le fichier excel! je sais créer le dossier, je sais créer le fichier mais je n'arrive à mettre le fichier dans le dossier! je vous fais parvenir la macro, si vous pouviez m'aider ça résoudrai un long projet !

Option Explicit
Dim Mess As Integer, r As String
Dim xnomfic As String, ficd As String, xcell As String, xnomsh As Variant
Dim xshcherchee As Worksheet
Sub Sauvegarde_Modele()
'CREER UN DOSSIER
r = Feuil23.[C2]
If Dir("C:\Users\coach\dropbox\Musculation\" & r, vbDirectory) = "" Then _
MkDir "C:\Users\coach\dropbox\Musculation\" & r
' CREER UN CLASSEUR dans le dossier
Application.ScreenUpdating = False
xnomfic = Range("C2"): ficd = xnomfic & ".xlsx": xcell = Range("F2"): xnomsh = Replace(xcell, "/", "")

' Contrôle de l'existence du fichier ou classeur
If FichierExiste("C:\Users\coach\dropbox\Musculation\" & ficd) = "Vrai" Then ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
' ------------------------------------------------------------------------------------------------------------------
' Le classeur existe - On recherche si la feuille existe
Workbooks.Open ("C:\Users\coach\dropbox\Musculation\" & ficd): Workbooks(ficd).Activate ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
For Each xshcherchee In Worksheets
If xshcherchee.Name = xnomsh Then
MsgBox "SAUVEGARDE IMPOSSIBLE - Cette feuille " & xnomsh & " existe déjà dans le classeur du joueur : " & xnomfic & ".", vbCritical
ActiveWorkbook.Save: ActiveWorkbook.Close
Workbooks("Musculation.xlsm").Sheets("Modele").Activate
Exit Sub
End If
Next

' Le classeur existe - On ajoute la feuille
Worksheets.Add After:=Sheets((Sheets.Count)): Worksheets(Sheets.Count).Name = xnomsh
Workbooks("Musculation.xlsm").Sheets("Modele").Range("A😛").Copy
With ActiveWorkbook.Sheets(xnomsh)
.Range("A😛").PasteSpecial Paste:=xlPasteValues
.Range("A😛").PasteSpecial Paste:=xlPasteFormats
.Range("A😛").PasteSpecial Paste:=xlPasteFormulas
End With
Application.CutCopyMode = False
MsgBox "Sauvegarde effectuée."
'ActiveWorkbook.SaveAs Filename:="C:\Users\coach\dropbox\Musculation\" & xnomfic & ".xlsx" ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
ActiveWorkbook.Save
ActiveWorkbook.Close
Workbooks("Musculation.xlsm").Sheets("Modele").Activate
' ------------------------------------------------------------------------------------------------------------------
Else
'___________________________________________________________________________________________________________________
' Création du fichier ou classeur et copie de la feuille modele
Workbooks.Add
Workbooks("Musculation.xlsm").Sheets("Modele").Range("A😛").Copy
With ActiveWorkbook.Sheets("Feuil1")
.Range("A😛").PasteSpecial Paste:=xlPasteValues
.Range("A😛").PasteSpecial Paste:=xlPasteFormats
.Range("A😛").PasteSpecial Paste:=xlPasteFormulas
End With
Application.CutCopyMode = False
ActiveSheet.Name = xnomsh
ActiveWorkbook.SaveAs Filename:="C:\Users\coach\dropbox\Musculation\" & xnomfic & ".xlsx" ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
ActiveWorkbook.Close
MsgBox "Sauvegarde effectuée."
End If
'___________________________________________________________________________________________________________________
Application.ScreenUpdating = True
End Sub

Function FichierExiste(ficd) As Boolean
FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function

Cordialement
jujunexcelpas
 
Trier par date Trier par votes
Re : créer un dossier puis un fichier dans le dossier via VBA

Bonjour

mais je n'arrive à mettre le fichier dans le dossier!
Cliquez pour agrandir...
Pas tout compris au soucis puisque, dans le cas d'un nouveau classeur, le code l'enregistre bien dans le répertoire.
(mais, a priori il manque un End If)

Y a t-il un message d'erreur ? sur quelle ligne s'arrête le code à l'exécution ?

A+ de précisions
 
Vote positif 0 Vote négatif
Re : créer un dossier puis un fichier dans le dossier via VBA

bonjour Paf, bbb38, et le forum,
pour le code je n'ai pas de message d'erreur simplement le fait que le dossier et le classeur s'enregistre côte à côte dans le dossier musculation!
j'ai un peu avancé sur le code en question cependant je me retrouve avec un problème j'ai 2 macros sur 2 dossiers différents qui doivent s'enregistrer de la même façon dans le dossier créé
le premier code c'est celui que je t'ai envoyé dans le premier message mais cette fois il fonctionne comme je le souhaite:

Code: 
Option Explicit
Dim xnomfic As String, ficd As String, xcell As String, xnomsh As Variant
Dim Chemin2 As String
Dim sDos As String
Dim xshcherchee As Worksheet
Function FichierExiste(ficd) As Boolean
    FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function
Function DossierExiste(sDos) As Boolean
    DossierExiste = Dir(sDos) <> "" And sDos <> ""
End Function
Sub Enregistrer6X35()

     ' CREER UN DOSSIER
      Application.ScreenUpdating = False
      Chemin2 = "C:\users\coach\dropbox\joueurs\"
      sDos = Workbooks("6X35.xlsm").Sheets("Modele").Range("M2")
      xnomfic = Range("M2"): ficd = xnomfic & " 6X35.xlsx"

    If DossierExiste(Chemin2 & sDos) = "Vrai" Then    ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
    
    ' CREER UN CLASSEUR
    Application.ScreenUpdating = False
    xnomfic = Range("M2"): ficd = xnomfic & " 6X35.xlsx"
    
[COLOR="#00FF00"]    ' Création du fichier ou classeur et copie de la feuille modele
[/COLOR]        Workbooks.Add
        Workbooks("6X35.xlsm").Sheets("Modele").Range("$A$1:$L$3").Copy
            With ActiveWorkbook.Sheets("Feuil1")
                .Range("$A$1:$L$3").PasteSpecial Paste:=xlPasteValues
                .Range("$A$1:$L$3").PasteSpecial Paste:=xlPasteFormats
                .Range("$A$1:$L$3").PasteSpecial Paste:=xlPasteFormulas
            End With
        Application.CutCopyMode = False
        ActiveWorkbook.SaveAs Filename:=Chemin2 & sDos & "\" & xnomfic & " 6X35.xlsx" ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ActiveWorkbook.Close
        MsgBox "Sauvegarde effectuée."
        '___________________________________________________________________________________________________________________
    Application.ScreenUpdating = True

    Else

    
  ' Contrôle de l'existence du fichier ou classeur
    If FichierExiste(Chemin2 & sDos & "\" & ficd) = "Vrai" Then ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE

        For Each xshcherchee In Worksheets
                If xshcherchee.Name = xnomsh Then
                    MsgBox "SAUVEGARDE IMPOSSIBLE - Cette feuille " & xnomsh & " existe déjà dans le classeur du joueur : " & xnomfic & ".", vbCritical
                    ActiveWorkbook.Save: ActiveWorkbook.Close
                    Workbooks("6X35.xlsm").Sheets("Modele").Activate
                    Exit Sub
                End If
            Next
            
        ' Le classeur existe - On insert le nouveau tableau
        Sheets("Modele").Range("$A$1:$L$3").Copy
        Workbooks.Open (Chemin2 & sDos & "\" & ficd): Workbooks(ficd).Sheets("Feuil1").Rows.Insert
        'ActiveWorkbook.SaveAs Filename:="C:\users\coach\dropbox\Tests\" & xnomfic & ".xlsx"    ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        MsgBox "Sauvegarde effectuée."
        
          ' ------------------------------------------------------------------------------------------------------------------
    Else
    
    ' Création d'un dossier
  
  MkDir Chemin2 & sDos
        '___________________________________________________________________________________________________________________
        ' Création du fichier ou classeur et copie de la feuille modele
        Workbooks.Add
        Workbooks("6X35.xlsm").Sheets("Modele").Range("$A$1:$L$3").Copy
            With ActiveWorkbook.Sheets("Feuil1")
                .Range("$A$1:$L$3").PasteSpecial Paste:=xlPasteValues
                .Range("$A$1:$L$3").PasteSpecial Paste:=xlPasteFormats
                .Range("$A$1:$L$3").PasteSpecial Paste:=xlPasteFormulas
            End With
        Application.CutCopyMode = False
        ActiveWorkbook.SaveAs Filename:=Chemin2 & sDos & "\" & xnomfic & " 6X35.xlsx" ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ActiveWorkbook.Close
        MsgBox "Sauvegarde effectuée."
        '___________________________________________________________________________________________________________________
    Application.ScreenUpdating = True
End If


End If

End Sub

Cependant le deuxième code qui devrait être identique au précédent ne fonctionne pas , aucun message d'erreur, bref aucune action:
Code: 
Option Explicit
Dim xnomfic As String, ficd As String, xcell As String, xnomsh As Variant
Dim Chemin2 As String
Dim sDos As String
Dim xshcherchee As Worksheet
Function FichierExiste(ficd) As Boolean
    FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function
Function DossierExiste(sDos) As Boolean
    DossierExiste = Dir(sDos) <> "" And sDos <> ""
End Function
Sub Sauvegarde_Modele()
    'CREER UN DOSSIER
       Application.ScreenUpdating = False
       Chemin2 = "C:\users\coach\dropbox\joueurs\"
       sDos = Workbooks("Musculation.xlsm").Sheets("Modele").Range("C2")
       xnomfic = Range("C2"): ficd = xnomfic & " Musculation.xlsx"

    If DossierExiste(Chemin2 & sDos) = "Vrai" Then    ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
    
    ' CREER UN CLASSEUR
    Application.ScreenUpdating = False
    xnomfic = Range("C2"): ficd = xnomfic & " Musculation.xlsx"
    
    ' Contrôle de l'existence du fichier ou classeur
    If FichierExiste(Chemin2 & sDos & "\" & ficd) = "Vrai" Then   ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ' ------------------------------------------------------------------------------------------------------------------
        ' Le classeur existe - On recherche si la feuille existe
        Workbooks.Open (Chemin2 & sDos & "\" & ficd): Workbooks(ficd).Activate    ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
            For Each xshcherchee In Worksheets
                If xshcherchee.Name = xnomsh Then
                    MsgBox "SAUVEGARDE IMPOSSIBLE - Cette feuille " & xnomsh & " existe déjà dans le classeur du joueur : " & xnomfic & ".", vbCritical
                    ActiveWorkbook.Save: ActiveWorkbook.Close
                    Workbooks("Musculation.xlsm").Sheets("Modele").Activate
                    Exit Sub
                End If
            Next
            
        ' Le classeur existe - On ajoute la feuille
        Worksheets.Add After:=Sheets((Sheets.Count)): Worksheets(Sheets.Count).Name = xnomsh
        Workbooks("Musculation.xlsm").Sheets("Modele").Range("A:P").Copy
            With ActiveWorkbook.Sheets(xnomsh)
                .Range("A:P").PasteSpecial Paste:=xlPasteValues
                .Range("A:P").PasteSpecial Paste:=xlPasteFormats
                .Range("A:P").PasteSpecial Paste:=xlPasteFormulas
            End With
        Application.CutCopyMode = False
        MsgBox "Sauvegarde effectuée."
        'ActiveWorkbook.SaveAs Filename:="C:\Users\coach\dropbox\Musculation\" & xnomfic & " Musculation.xlsx"    ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ActiveWorkbook.Save
        ActiveWorkbook.Close
        Workbooks("Musculation.xlsm").Sheets("Modele").Activate
        ' ------------------------------------------------------------------------------------------------------------------
    Else
        '___________________________________________________________________________________________________________________
        ' Création du fichier ou classeur et copie de la feuille modele
        Workbooks.Add
        Workbooks("Musculation.xlsm").Sheets("Modele").Range("A:P").Copy
            With ActiveWorkbook.Sheets("Feuil1")
                .Range("A:P").PasteSpecial Paste:=xlPasteValues
                .Range("A:P").PasteSpecial Paste:=xlPasteFormats
                .Range("A:P").PasteSpecial Paste:=xlPasteFormulas
            End With
        Application.CutCopyMode = False
        ActiveSheet.Name = xnomsh
        ActiveWorkbook.SaveAs Filename:=Chemin2 & sDos & "\" & xnomfic & " Musculation.xlsx"    ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ActiveWorkbook.Close
        MsgBox "Sauvegarde effectuée."
    End If
    
    End If
        '___________________________________________________________________________________________________________________
    Application.ScreenUpdating = True
End Sub

je ne trouve pas le problème, c'est la premièrefois que je suis sur un code aussi complexe notamment grâce à bbb38, mais là j'avoue je bloque un peu.
merci encore pour le temps que vous prenez! je vous avoue avoir acheté un livre sur le langage VBA car je m'y intéresse de plus en plus et cela grâce à des gens comme vous !
Cordialement
Julien
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
372
MarineU
M
Chaton77
  • Résolu(e)
Microsoft 365 Vba : Transférer des données d'un tableau dans un autre fichier
Réponses
7
Affichages
471
Chaton77
Chaton77
F
  • Question Question
Microsoft 365 Copier un dossier et son contenu puis y enregistrer un classeur. Renommer chaque élément selon des valeurs de cellules
Réponses
1
Affichages
730
Zon
Z
H
  • Résolu(e)
XL 2019 récupérer une donnée d'un fichier csv pour le copier vers un autre
2
Réponses
27
Affichages
2 K
Hutchy33
H
AugusteP
  • Question Question
XL 2021 Comment créer un code VBA afin de création un chemin d'accès universel
Réponses
8
Affichages
1 K
AugusteP
AugusteP
O
  • Question Question
XL 2010 suppression fichiers excel vba
Réponses
9
Affichages
552
Oneida
Oneida
S
  • Question Question
XL 2019 Enregistrer plusieurs feuilles excel en un fichier PDF dans un dossier portant le nom d'une cellule
Réponses
4
Affichages
2 K
Phil69970
Phil69970
A
  • Question Question
Microsoft 365 VBA: importer dans un dossier avec un nom variable
Réponses
4
Affichages
925
A-F
A
K
  • Résolu(e)
Microsoft 365 Ouvrir un autre classeur excel (VBA) pour utiliser les données de celui dans le classeur actif
Réponses
5
Affichages
1 K
Dranreb
Dranreb
A
  • Question Question
XL 2019 Résolu - Bug code VBA modifier xxx fichiers en boucle
Réponses
3
Affichages
629
fanch55
fanch55
A
  • Question Question
Microsoft 365 Copier le contenu d'une feuille dans une autre par une macro
Réponses
2
Affichages
967
AlexAGEMS
A
E
  • Résolu(e)
Microsoft 365 Créer une macro qui va dans un dossier récupérer un fichier
5 6 7
Réponses
92
Affichages
10 K
Etoto
Etoto
O
  • Résolu(e)
XL 2013 Rajouter une bordure noire dans un tableau par VBA
Réponses
5
Affichages
943
Lolote83
L
A
  • Question Question
XL 2013 Ouvrir un fichier Excel sur le réseau et coller des valeurs
Réponses
9
Affichages
2 K
sylvanu
sylvanu
B
  • Question Question
XL 2019 bug dans l'enregistrement (VBA)
Réponses
9
Affichages
2 K
bluesky12000
B
R
  • Question Question
XL 2016 Gestion de chemin de fichiers + VBA
Réponses
0
Affichages
3 K
Ryoken
R
E
  • Question Question
XL 2013 Copier ligne from last feuil d'1 classeur vers un autre classeur
Réponses
8
Affichages
1 K
ebenezerkonan
E
W
  • Résolu(e)
Microsoft 365 Boucle Loop infinie lors écriture dans des fichier
Réponses
7
Affichages
1 K
Staple1600
Staple1600
O
  • Question Question
XL 2019 Excel VBA - Condition selon le nom du fichier
Réponses
5
Affichages
2 K
Staple1600
Staple1600
D
  • Question Question
Microsoft 365 Concatener plusieurs fichier dans un fichier et onglet unique
Réponses
9
Affichages
1 K
de_hanstrapp
D
Retour