Copier plusieurs fichier vers dossier en doublon Macro VBA

Bonjour,

Je suis nouveau sur votre forum et je n'ai pas l'habitude de demander de l'aide, j'aime me débrouiller seul mais la j'avoue que cela dépasse mes compétences qui sont un peux limitées.

J'explique j'ai créé ce fichier pour mon boulot (tout seule comme un grand ) et je bloque lors de la copie des fichier pdf dans le dossier de destination.

Cela fonctionne mais le hic c'est lorsque les fichier sont en doublons, ils me les remplaces et je ne veux pas.

Je voudrais par exemple un fichier comme ci-dessous:

de base : Ad-A3H-001.pdf

doublon : Ad-A3H-001 - Copie.pdf

doublon suivant : Ad-A3H-001 - Copie (2).pdf

et aussi de suite...

voir la macro COPIERFICHIERPDF1 sur mon fichier.

Il me reste un autre souci je n'arrive pas non plus à copier des fichiers lorsque celui ci à une quantité x2 comme indiqué sur la cellule N23 (elle aussi soumise ensuite au Problème de doublon par la suite avec les autres case et ainsi de suite).

Je vous remercie de votre aide.

Bonjour Miller77

Petite question ton problème ce situe dans les sub "Sub COPIERFICHIERPDF" ?

Pourquoi toutes ces sub d'ailleurs ?

Tu peux commencer par remplacer toutes tes Sub par 1 seule

Edit : Pour la copie des fichiers en doublon j'ai créé le code à tester

' Penser à mettre cette option en tête des modules
Option Explicit

Sub CopierFichierPDF()
  'Declaration
  Dim Lig As Long, Inc As Integer
  Dim FSO
  Dim sFile As String, sFileTmp As String
  Dim sSFolder As String
  Dim sDFolder As String
  'Create Object for File System
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ' For each row of 23 to 47
  For Lig = 23 To 47
    'This is Your File Name which you want to Copy.You can change File name at U23.
    sFile = Sheets("Modèle").Range("U" & Lig)
    'Change to match the source folder path. You can change Source Folder name at V23.
    sSFolder = Sheets("Modèle").Range("V" & Lig)
    'Change to match the destination folder path. You can change Destination Folder name at W23.
    sDFolder = Sheets("Modèle").Range("W" & Lig)
    'Checking If File Is Located in the Source Folder
    If Not FSO.FileExists(sSFolder & sFile) Then
      MsgBox "Specified File Not Found in Source Folder", vbInformation, "Not Found"
      GoTo SuiteLigne
    End If
    'Copying If the Same File is Not Located in the Destination Folder
    If Not FSO.FileExists(sDFolder & sFile) Then
      FSO.CopyFile (sSFolder & sFile), sDFolder, True
      MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!"
    Else
      ' The file already exist use increment
      Inc = 1
      sFileTmp = Left(sFile, InStr(1, sFile, ".pdf")) & "Ex" & Format(Inc, "00") & ".pdf"
      Do While FSO.FileExists(sDFolder & sFileTmp)
        Inc = Inc + 1
        sFileTmp = Left(sFile, InStr(1, sFile, ".pdf")) & "Ex" & Format(Inc, "00") & ".pdf"
      Loop
      FSO.CopyFile (sSFolder & sFile), sDFolder & sFileTmp, True
      MsgBox "Specified File Copied to Destination Folder Successfully with number : Ex" & Inc, vbInformation, "Done!"
    End If

SuiteLigne:
  Next Lig
End Sub

D'après le code initial, tes fichiers de destination ne sont pas remplacés, mais tu as un message qui doit apparaître

A+

Tout d'abord Merci de ta réactivité.

Je suis vraiment autodidacte sur excel, je fouine, je cherche, je bidouille, si tu regarde de plus prêt je suis sûre que tu te tirerais les cheveux lol!

En tout cas parfait cette macro unique, j'avais cherché la solution mais je n'avais point trouver j'avais donc contourner comme d'hab.

Effectivement mes fichiers ne sont pas remplacer mais je voudrais qu'ils soit copier avec incrémentation quand cela est le cas, si j'ai 18 fichiers ou lignes dans mon tableau je dois avoir 18 PDF au final même avec des fichiers avec des noms similaires.

A cela se rajoute comme j'avais indiquer le problème de la quantité ensuite mais déjà si mon première problème est résolu ça sera déjà ça de gagné.

Vraiment merci, ton code marche nickel.

Je pourrais encore abusé et te demander de voir pour le problème de quantité?

Sur ma feuille colonne N23:N47 j'ai des quantités et si je met 2 pour N23 il me faudrait aussi 2 fichier au lieu de 1, cela se complique .

Je sais pas trop si c'est bien clair mon histoire.

Re,

Oui effectivement je n'ai pas traité ce problème je regarde

Voici le code à tester

Option Explicit

Sub CopierFichierPDF()
  'Declaration
  Dim Lig As Long, Inc As Integer, NbQt As Integer, Qt As Integer
  Dim FSO As Object, Wst As Worksheet
  Dim sFile As String, sFileTmp As String
  Dim sSFolder As String
  Dim sDFolder As String
  'Create Object for File System
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ' Define the worksheet
  Set Wst = ThisWorkbook.Sheets("Modèle")
  ' For each row of 23 to 47
  For Lig = 23 To 47
    'This is Your File Name which you want to Copy.You can change File name at U23.
    sFile = Wst.Range("U" & Lig)
    'Change to match the source folder path. You can change Source Folder name at V23.
    sSFolder = Wst.Range("V" & Lig)
    'Change to match the destination folder path. You can change Destination Folder name at W23.
    sDFolder = Wst.Range("W" & Lig)
    'Checking If File Is Located in the Source Folder
    If Not FSO.FileExists(sSFolder & sFile) Then
      MsgBox "Specified File Not Found in Source Folder", vbInformation, "Not Found"
      GoTo SuiteLigne
    End If
    ' Quantity
    NbQt = Wst.Range("N" & Lig)
    ' For each Quantity
    For Qt = 1 To NbQt
      'Copying If the Same File is Not Located in the Destination Folder
      If Not FSO.FileExists(sDFolder & sFile) Then
        FSO.CopyFile (sSFolder & sFile), sDFolder, True
        MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!"
      Else
        ' The file already exist use increment
        Inc = 1
        sFileTmp = Left(sFile, InStr(1, sFile, ".pdf")) & "Ex" & Format(Inc, "00") & ".pdf"
        Do While FSO.FileExists(sDFolder & sFileTmp)
          Inc = Inc + 1
          sFileTmp = Left(sFile, InStr(1, sFile, ".pdf")) & "Ex" & Format(Inc, "00") & ".pdf"
        Loop
        FSO.CopyFile (sSFolder & sFile), sDFolder & sFileTmp, True
        MsgBox "Specified File Copied to Destination Folder Successfully with number : Ex" & Inc, vbInformation, "Done!"
      End If
    Next Qt

SuiteLigne:
  Next Lig
End Sub

A+

Je te remercie beaucoup cela fonctionne parfaitement.

il y avait une erreur à la ligne :

Set Wst = ThisWorkbook.Sheets("Modèle")

j'ai viré :ThisWorkbook. et cela à marché

Pour la rapidité j'ai supprimé les messages.

Encore merci pour ton aide c'est géniale.

A bientôt.

Bonjour à tous,

Je reviens vers vous avec mon petit fichier excel qui marche du tonnerre mais il me manque encore un petit truc pour qu'il soit parfait.

J'aimerais incrémenter la copie de mes fichiers .pdf avec les numéros qui vont bien en case A23 et A75.

En faite je voudrais copie mes fichiers comme aujourd’hui mais avec les noms modifié dans les case correspondante de Z23 à Z75.

Je vous remercie d'avance pour vos réponse.

Merci.

Bonjour Miler77,

Voici le code initial rectifié selon les nouvelles colonnes et ta nouvelle demande

Il est dommage que tu n'essayes pas d'analyser le code, le changement à faire est ultra simple

Sub CopierFichierPDF()
  'Declaration
  Dim Lig As Long
  Dim FSO As Object
  Dim sFile As String
  Dim sSFolder As String
  Dim sDFolder As String
  'Create Object for File System
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ' For each row of 23 to 75
  For Lig = 23 To 75
    'This is Your File Name which you want to Copy.You can change File name at Zxx.
    sFile = Sheets("Modèle").Range("Z" & Lig)
    'Change to match the source folder path. You can change Source Folder name at V23.
    sSFolder = Sheets("Modèle").Range("W" & Lig)
    'Change to match the destination folder path. You can change Destination Folder name at W23.
    sDFolder = Sheets("Modèle").Range("X" & Lig)
    'Checking If File Is Located in the Source Folder
    If Not FSO.FileExists(sSFolder & sFile) Then
      MsgBox "Specified File Not Found in Source Folder", vbInformation, "Not Found"
      'Copying If the Same File is Not Located in the Destination Folder
    ElseIf Not FSO.FileExists(sDFolder & sFile) Then
      FSO.CopyFile (sSFolder & sFile), sDFolder, True
      MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!"
    Else
      MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
    End If
  Next Lig
  ' Effacer la variable objet
  Set FSO = Nothing
End Sub

A+

Bonjour Bruno,

Je te remercie encore pour ton aide.

Mais j'ai essayé pourtant, ça fait déjà plus de 2 semaines que je suis dessus et pas possible de trouver la solution.

Je vais analyser ton code pour trouver la ou je n'y arrivais pas.

Merci.

Rebonjour Bruno,

En faite c'est plus compliqué que ça, je me suis sûrement mal expliquer.

Je veux garder le fichier source en colonne V :

Set FSO = CreateObject("Scripting.FileSystemObject")

' For each row of 23 to 75

For Lig = 23 To 75

'This is Your File Name which you want to Copy.You can change File name at Vxx.

sFile = Sheets("Modèle").Range("V" & Lig)

Mais après ce fichier la en colonne v je veux effectivement le coller dans le fichier source mais avec un renommage du fichier avec une correspondance de colonne, ici la colonne A.

Pour la ligne 23 en exemple--

Départ : Div-A3H-011.pdf

source : ok

destination : ok

Nom du fichier au final : "A23&-"Div-A3H-011.pdf

En faite le code était déjà pas mal car il y avait l'incrémentation qui allait bien au cas ou il y avait un doublon et la relation avec la quantités qui allait bien aussi.

Je sais pas si c'est possible de faire tout ça en même temps avec le filecopy.

Je te remercie.

Re,

Peut-être ce code ci

Sub CopierFichierPDF()
  'Declaration
  Dim Lig As Long
  Dim FSO As Object
  Dim sFileSce As String, sFileDes As String
  Dim sFolderSce As String, sFolderDes As String
  'Create Object for File System
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ' For each row of 23 to 75
  For Lig = 23 To 75
    ' This is Your File Name which you want to Copy. You can change File name at Vxx.
    sFileSce = Sheets("Modèle").Range("V" & Lig)
    ' This is Your File Name which you want.
    sFileDes = Sheets("Modèle").Range("Z" & Lig)
    'Change to match the source folder path. You can change Source Folder name at V23.
    sFolderSce = Sheets("Modèle").Range("W" & Lig)
    'Change to match the destination folder path. You can change Destination Folder name at W23.
    sFolderDes = Sheets("Modèle").Range("X" & Lig)
    'Checking If File Is Located in the Source Folder
    If Not FSO.FileExists(sFolderSce & sFileSce) Then
      MsgBox "Specified File Not Found in Source Folder", vbInformation, "Not Found"
      'Copying If the Same File is Not Located in the Destination Folder
    ElseIf Not FSO.FileExists(sFolderDes & sFileDes) Then
      FSO.CopyFile sFolderSce & sFileSce, sFolderDes & sFileDes, True
      MsgBox "Specified File Copied to Destination Folder Successfully", vbInformation, "Done!"
    Else
      MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
    End If
  Next Lig
  ' Effacer la variable objet
  Set FSO = Nothing
End Sub

A+

Ca marche nickel.

Milles merci à toi.

Mais que pense tu de ça?? pour l'intégration des quantités et incrémentation?

J'ai un souci l'incrémentation fonctionne mais j'ai un fichier de plus pour chaque ligne, je m'explique.

Si je met des quantité de 3 au lieu de me retrouver avec 3 fichier, je me retrouve avec 4 fichiers

Sub edcopie()
  'Declaration
 Dim Lig As Long, Inc As Integer, NbQt As Integer, Qt As Integer
  Dim FSO As Object
  Dim sFileSce As String, sFileDes As String
  Dim sFolderSce As String, sFolderDes As String
  'Create Object for File System
 Set FSO = CreateObject("Scripting.FileSystemObject")
  ' For each row of 23 to 97
 For Lig = 23 To 97
    ' This is Your File Name which you want to Copy. You can change File name at Vxx.
   sFileSce = Sheets("Modèle").Range("V" & Lig)
    ' This is Your File Name which you want.
   sFileDes = Sheets("Modèle").Range("Z" & Lig)
    'Change to match the source folder path. You can change Source Folder name at V23.
   sFolderSce = Sheets("Modèle").Range("W" & Lig)
    'Change to match the destination folder path. You can change Destination Folder name at W23.
   sFolderDes = Sheets("Modèle").Range("X" & Lig)
    'Checking If File Is Located in the Source Folder
   If Not FSO.FileExists(sFolderSce & sFileSce) Then
      MsgBox "Specified File Not Found in Source Folder", vbInformation, "Not Found"
     'Copying If the Same File is Not Located in the Destination Folder
   ElseIf Not FSO.FileExists(sFolderDes & sFileDes) Then
      FSO.CopyFile sFolderSce & sFileSce, sFolderDes & sFileDes, True
    Else
      MsgBox "Specified File Already Exists In The Destination Folder", vbExclamation, "File Already Exists"
      GoTo SuiteLigne
    End If
    ' Quantity
   NbQt = Sheets("Modèle").Range("o" & Lig)
    ' For each Quantity
   For Qt = 1 To NbQt
      'Copying If the Same File is Not Located in the Destination Folder
     If Not FSO.FileExists(sFolderDes & sFileDes) Then
        FSO.CopyFile sFolderSce, sFolderDes & sFileSce, True

      Else
        ' The file already exist use increment
       Inc = 1
        sFileTmp = Left(sFileDes, InStr(1, sFileDes, ".pdf")) & "Ex" & Format(Inc, "00") & ".pdf"
        Do While FSO.FileExists(sFolderDes & sFileTmp)
          Inc = Inc + 1
          sFileTmp = Left(sFileDes, InStr(1, sFileDes, ".pdf")) & "Ex" & Format(Inc, "00") & ".pdf"
        Loop
        FSO.CopyFile (sFolderSce & sFileSce), sFolderDes & sFileTmp, True

      End If
    Next Qt

SuiteLigne:
  Next Lig
  ' Effacer la variable objet
 Set FSO = Nothing
End Sub

@+

Re,

Essayes peut-être tout simplement avec ce code

On utilise la quantité comme incrément supplémentaire au nom de fichier

Sub CopierFichierPDFAvecQt()
  'Declaration
  Dim FSO As Object
  Dim Lig As Long, Inc As Integer, NbQt As Integer, Qt As Integer
  Dim sFileSce As String, sFileDes As String, sFileTmp As String
  Dim sFolderSce As String, sFolderDes As String
  'Create Object for File System
  Set FSO = CreateObject("Scripting.FileSystemObject")
  ' For each row of 23 to 97
  For Lig = 23 To 97
    ' This is Your File Name which you want to Copy. You can change File name at Vxx.
    sFileSce = Sheets("Modèle").Range("V" & Lig)
    ' This is Your File Name which you want.
    sFileDes = Sheets("Modèle").Range("Z" & Lig)
    'Change to match the source folder path. You can change Source Folder name at V23.
    sFolderSce = Sheets("Modèle").Range("W" & Lig)
    'Change to match the destination folder path. You can change Destination Folder name at W23.
    sFolderDes = Sheets("Modèle").Range("X" & Lig)
    ' Quantity
    NbQt = Sheets("Modèle").Range("o" & Lig)
    ' For each Quantity
    For Qt = 1 To NbQt
      ' Créer le nom du fichier avec l'incrément de la quantité
      sFileTmp = Left(sFileDes, InStr(1, sFileDes, ".pdf")) & "Ex" & Format(Qt, "00") & ".pdf"
      ' Copier le fichier s'il n'existe pas dans la destination
      If Not FSO.FileExists(sFolderDes & sFileTmp) Then
        FSO.CopyFile sFolderSce & sFileSce, sFolderDes & sFileTmp, True
      End If
    Next Qt
  Next Lig
  ' Effacer la variable objet
  Set FSO = Nothing
End Sub

A+

Ca fonctionne parfaitement.

C'était si simple finalement mais quand on part de zero c'est pas évident.

Je te remercie en tout cas.

@+