Création dossier et fichier Excel dans ce dossier

Question

Je vous sollicite pour m'aider à compléter une macro sur Excel : L'objectif est de créer un dossier avec le fichier excel à l'intérieur de celui-ci/ Je bute sur la 2ème partie. Je vous remercie pour toute l'aide que vous m'apporterez :) Voici mon code : Sub CréationDossier() ' ' CréationDossier Macro 'variables Dim chemin_du_dossier As String Dim nom_du_dossier As String nom_du_dossier = Range("a2").Value 'identifier le chemin du dossier chemin_du_dossier = "R:\DOSSIERS COMMUNS NEW\FICHES CREATIONS FOURNISSEURS\" & nom_du_dossier & " - " & Format(Date, "yyyy" & "mm" & "dd") 'tester son existence If Dir(chemin_du_dossier, vbDirectory) &lt;&gt; vbNullString Then Else 'si le dossier n'existe pas, le créer MkDir (chemin_du_dossier) 'msg de fin MsgBox ("Le dossier est créé") End If End Sub Edit modo : code mis entre balises, merci d'y faire attention la prochaine fois...

Invité · Accepted Answer

Petit rappel de la CHARTE : Pour plus de lisibilité, utilisez la fonctionnalité (bouton) &lt;/&gt; pour insérer vos codes VBA (et si possible aussi pour vos formules Excel). Sinon concernant votre demande, ou se trouve le fichier Excel en question ? A+...

Invité · Accepted Answer

Re, Je parlais de ça Quel fichier Excel ? Ou est-il au départ ? A+...

Invité · Accepted Answer

Re,

Ce n'est pas grave, seulement plus compliqué de se comprendre

Sinon avec une feuille "Params" ajoutée pour mettre le chemin et le nom du fichier à copier

Sub CréationDossier()
  'variables
  Dim CheminDossier As String
  Dim NomDosFour As String
  Dim sPathDA As String, sNomFic As String
  Dim NomFichier As String
  '
  NomDosFour = Sheets("Création dossier et fiche").Range("A2").Value
  ' Avec la feuille (objet conteneur)
  With Sheets("Params")
   sPathDA = .Range("A2").Value
   If Right(sPathDA, 1) <> "\" Then sPathDA = sPathDA & "\"
   sNomFic = .Range("A4").Value
  End With
  '
  ' Identifier le chemin du dossier
  CheminDossier = "R:\DOSSIERS COMMUNS NEW\FICHES CREATIONS FOURNISSEURS\" & NomDosFour & " - " & Format(Date, "yyyy" & "mm" & "dd")
  ' tester son existence
  If Dir(CheminDossier, vbDirectory) = vbNullString Then
    'si le dossier n'existe pas, le créer
    MkDir CheminDossier
    ' Copier le fichier Excel dedans
    FileCopy sPathDA & sNomFic, CheminDossier & "\" & sNomFic
  End If
End Sub

Voici le fichier modifié

19jouvetsandrine-fiche-creation-fournisseur-fruits-et-legumes-vb.xlsm (48.44 Ko)

A+

Invité · Accepted Answer

Il faut ajouter devant cette ligne les instructions Debug.Print sPathDA & sNomFic Debug.Print CheminDossier & "\" & sNomFic Et donnez nous ce qui s'affiche dans votre fenêtre d'exécution A+...

Invité · Accepted Answer

Sandrine,

Nous sommes bien d'accord, le dossier et le fichier d'origine existe bien

Sinon essayez avec ce code modifié, j'ai également mis des noms de variables un peu plus "explicite"

Sub CréationDossier()
  'variables
  Dim sPathIni As String, sPathDes As String
  Dim sNomFour As String, sNomFic As String
  '
  sNomFour = Sheets("Création dossier et fiche").Range("A2").Value
  ' Avec la feuille (objet conteneur)
  With Sheets("Params")
   sPathIni = .Range("A2").Value
   If Right(sPathIni, 1) <> "\" Then sPathIni = sPathIni & "\"
   sNomFic = .Range("A4").Value
  End With
  '
  ' Identifier le chemin du dossier
  sPathDes = sPathIni & sNomFour & " - " & Format(Date, "yyyy" & "mm" & "dd")
  If Right(sPathDes, 1) <> "\" Then sPathDes = sPathDes & "\"
  ' tester son existence
  If Dir(sPathDes, vbDirectory) = vbNullString Then
    'si le dossier n'existe pas, le créer
    MkDir sPathDes
    ' Mettre un petit timer le temps que le dossier se créé
    Application.Wait Now + TimeValue("00:00:03")
    ' Copier le fichier Excel dedans
    FileCopy sPathIni & sNomFic, sPathDes & sNomFic
  End If
End Sub

Testé sur mon poste, cela fonctionne

A+

Invité · Accepted Answer

Re, Navré Sandrine, mais je ne comprends pas pourquoi ! Je mets le fichier test que j'ai testé au cas ou Sinon, le problème se situe sur ce fichier test ou le fichier réel ? A+...

Jean-Paul · Accepted Answer

Je pense que FileCopy n'apprécie pas le fait que le classeur soit ouvert, préfère lui ThisWorkbook.SaveACopy If Dir(CheminDossier, vbDirectory) = vbNullString Then 'si le dossier n'existe pas, le créer MkDir CheminDossier ' Copier le fichier Excel dedans ThisWorkbook.SaveCopyAs sPathDA & sNomFic, CheminDossier & "\" & sNomFic End If End Sub Ps. je n'ai pas testé le nom des variables et chemins....

Invité · Accepted Answer

Bonsoir Jean-Paul

A quel moment as-tu vu que le classeur en question était ouvert

Il porte le même nom, mais un est en ".xlsx" et l'autre ".xlsm", je te l'accorde ce n'est pas terrible
L'erreur donnée est : '53' : Fichier introuvable.

@Sandrine, si c'est ça la fessée

Jean-Paul · Accepted Answer

Je n'ai fait que supposer n'ayant pas ouvert les classeur... Tu ne dois indiquer que le chemin et nom de fichier cible et pas celui de la source... Méthode Workbook.SaveCopyAs (Excel) | Microsoft Learn...

Invité · Accepted Answer

...