Copier fichiers spécifiques dans des dossiers prédéfinis

Bonjour,

Je débute sur VBA et je rencontre actuellement un problème que je n'arrive pas à identifier.

De manière globale, je cherche à copier plusieurs fichiers spécifiques se trouvant dans un dossier A, et les coller dans un autre dossier différent pour chaque fichier.

Si un fichier spécifique ne se trouve pas dans le dossier A, alors la fonction continue pour les autres fichiers.

A la fin de l'opération, tous les fichiers du dossier A sont supprimés.

Voici mon fichier pour le moment.

10test-1.xlsm (15.27 Ko)

Et le code qui s'y trouve :

Private Sub CommandButton1_Click()

Dim Rep1 As String
Dim RepExcel As String
Dim RepTexte As String
Dim i As Integer

Dim last_row As Integer
last_row = Application.CountA(sh.Range("C:C"))

For i = 2 To last_row
Rep1 = sh.Range("C" & i).Value
RepExcel = sh.Range("D" & i).Value
If ThisWorkbook.Worksheets("Test").Range("B" & i).Value = "OUI" Then
Set Fs = CreateObject("Scripting.FileSystemObject")
Fs.CopyFile Rep1 & "*.xls", RepExcel
End If

If Dir(Rep1) = "" Then
    Exit Sub
End If

Next i

Fs.DeleteFile Rep1 & "*.xls"
End Sub

Merci beaucoup pour votre aide.

Maxime

Hello,

Pas testé mais déjà ton code commence mal,

Private Sub CommandButton1_Click()

Dim Rep1 As String
Dim RepExcel As String
Dim RepTexte As String
Dim i As Integer

Dim last_row As Integer
last_row = Application.CountA(sh.Range("C:C"))

C'est quoi "sh" ???

Corrige ça puis réessaye

Bonjour

personnellement je ne ferais pas une copie et une suppression mais directement un déplacement...

Sans vérifier que le dossier de destination existe et en supposant les noms des chemins de destination finissent jamais avec "\" dans la colonne D...

on pourrait écrire le code suivant (Pas testé)

Private Sub CommandButton1_Click()
Dim sh As Worksheet
Dim Fs
Dim i As Integer

Set sh = Sheets("Test")
Set Fs = CreateObject("Scripting.FileSystemObject")
For i = 2 To sh.Range("A" & Rows.Count).End(xlUp).Row
    If UCase(sh.Range("B" & i).Value) = "OUI" Then
        If Fs.FileExists(sh.Range("C" & i)) Then Fs.movefile sh.Range("C" & i), sh.Range("D" & i) & "\" & Fs.GetFileName(sh.Range("C" & i))
    End If
Next i
End Sub

Bonjour et merci pour vos retours.

@Rag02700: j'ai testé sans le sh. mais ceci est une référence qui a l'habitude de fonctionner sur d'autres VBA.

@Fred2406 : merci beaucoup, c'est effectivement encore plus simple de cette manière. Ton code fonctionne parfaitement !

Grand merci ! :)

Rechercher des sujets similaires à "copier fichiers specifiques dossiers predefinis"