XL 2010 Rech fichier contenant la valeur d'une cellule d'un tableau excel et copier/coller/sup

jeanmi

XLDnaute Occasionnel
Bonjour à tous,

J’ai deux répertoires :

Le répertoire (A) ou il y a beaucoup de fichiers
Le répertoire (B) ou je voudrais déplacer des fichiers
J’ai un fichier Excel avec des noms en colonne (AC) de la ligne 4 à la ligne X

Ce que je recherche à faire :

Une boucle, ça OK
For i= 4 to X

Comment faire la recherche ???
a) Dans le répertoire (A) rechercher s’il y a un fichier qui contient le nom_rech = cells(i, 29) dans le nom du fichier avec n’importe quelle extension.
b) Copier ce fichier dans le répertoire (B)
c) Supprimer ce fichier du répertoire (A)
d) Continuer la recherche pour voir s’il y a encore d’autres fichiers qui contiennent la désignation de la Cells(i,29) avec n’importe quelle extension.
e) S’il n’y a plus de fichier avec le nom_rech, passer à la ligne suivante

Next i

j'ai un peut d'appréhension de faire des essais avec des morceaux de macro trouvées sur le net et de faire la pagaille dans mon disque dure.
C'est pour cela que je demande de l'aide, afin de partir sur des bonnes bases sans risque.
Merci d'avance pour votre aide

Cordialement
 

BrunoM45

XLDnaute Barbatruc
Bonjour Jeanmi,

Normalement un code comme celui-ci devrait aller
Bien entendu, il faut changer l'arborescence du répertoire A et B, sans oublier le "\" à la fin ;)
VB:
Sub DéplacerFichier()
  Dim dLig As Long, Lig As Long
  Dim RepA As String, RepB As String
  Dim Lib As String, sNomFic As String
  ' Répertoire A
  RepA = "C:\RépertoireA\"
  RepB = "C:\RépertoireB\"
  ' Avec l'objet conteneur
  With Sheets("Feuil1")
    ' Dernière ligne remplie de la colonne AC
    dLig = .Range("AC" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 4 To dLig
      Lig = .Range("AC" & Lig).Value
      ' Vérifier si un fichier existe dans le répertoire A
      sNomFic = Dir(RepA & "*" & Lib & "*.*")
      If sNomFic <> "" Then
        ' Déplacer le fichier, utilisation de l'instruction Name
        Name RepA & sNomFic As RepB & sNomFic
      End If
    Next Lig
  End With
End Sub

A+
 

jeanmi

XLDnaute Occasionnel
Bonjour Jeanmi,

Normalement un code comme celui-ci devrait aller
Bien entendu, il faut changer l'arborescence du répertoire A et B, sans oublier le "\" à la fin ;)
VB:
Sub DéplacerFichier()
  Dim dLig As Long, Lig As Long
  Dim RepA As String, RepB As String
  Dim Lib As String, sNomFic As String
  ' Répertoire A
  RepA = "C:\RépertoireA\"
  RepB = "C:\RépertoireB\"
  ' Avec l'objet conteneur
  With Sheets("Feuil1")
    ' Dernière ligne remplie de la colonne AC
    dLig = .Range("AC" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 4 To dLig
      Lig = .Range("AC" & Lig).Value
      ' Vérifier si un fichier existe dans le répertoire A
      sNomFic = Dir(RepA & "*" & Lib & "*.*")
      If sNomFic <> "" Then
        ' Déplacer le fichier, utilisation de l'instruction Name
        Name RepA & sNomFic As RepB & sNomFic
      End If
    Next Lig
  End With
End Sub

A+
bonjour @BrunoM45 , bonjour à tous,

merci pour la réponse.
juste une question avant de tester :
le code permet bien de déplacer tous les fichiers qui contiennent un nom avec n'importe quelle extension puis après de passer à la ligne suivante pour faire la même chose ?
Il peut y avoir entre 4 et 8 fichiers à chaque fois à déplacer par ligne.

Comme je ne comprends pas bien je préfère poser la question .

Merci pour la réponse

Cordialement
 

BrunoM45

XLDnaute Barbatruc
Re,

Arf, donc le code n'est pas bon 🤣

Voici le correctif ;)
VB:
Sub DéplacerFichier()
  Dim dLig As Long, Lig As Long
  Dim RepA As String, RepB As String
  Dim Lib As String, sNomFic As String
  ' Répertoire A
  RepA = "C:\RépertoireA\"
  RepB = "C:\RépertoireB\"
  ' Avec l'objet conteneur
  With Sheets("Feuil1")
    ' Dernière ligne remplie de la colonne AC
    dLig = .Range("AC" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 4 To dLig
      ' Récupérer le critère à rechercher
      Lig = .Range("AC" & Lig).Value
      ' Vérifier si un fichier existe dans le répertoire A
      sNomFic = Dir(RepA & "*" & Lib & "*.*")
      ' Tant qu'on as un fichier
      Do While sNomFic <> ""
        ' Déplacer le fichier, utilisation de l'instruction Name
        Name RepA & sNomFic As RepB & sNomFic
        ' Fichier suivant avec même critère
        sNomFic = Dir
      Loop
      ' Plus de fichier, on passe au critère suivant
    Next Lig
  End With
End Sub

A+
 

jeanmi

XLDnaute Occasionnel
Re,

Arf, donc le code n'est pas bon 🤣

Voici le correctif ;)
VB:
Sub DéplacerFichier()
  Dim dLig As Long, Lig As Long
  Dim RepA As String, RepB As String
  Dim Lib As String, sNomFic As String
  ' Répertoire A
  RepA = "C:\RépertoireA\"
  RepB = "C:\RépertoireB\"
  ' Avec l'objet conteneur
  With Sheets("Feuil1")
    ' Dernière ligne remplie de la colonne AC
    dLig = .Range("AC" & Rows.Count).End(xlUp).Row
    ' Pour chaque ligne
    For Lig = 4 To dLig
      ' Récupérer le critère à rechercher
      Lig = .Range("AC" & Lig).Value
      ' Vérifier si un fichier existe dans le répertoire A
      sNomFic = Dir(RepA & "*" & Lib & "*.*")
      ' Tant qu'on as un fichier
      Do While sNomFic <> ""
        ' Déplacer le fichier, utilisation de l'instruction Name
        Name RepA & sNomFic As RepB & sNomFic
        ' Fichier suivant avec même critère
        sNomFic = Dir
      Loop
      ' Plus de fichier, on passe au critère suivant
    Next Lig
  End With
End Sub

A+
re @BrunoM45 , à tous,

Merci pour cette réponse rapide.
Je teste demain

Cordialement
 

Discussions similaires

Statistiques des forums

Discussions
292 811
Messages
1 926 469
Membres
183 093
dernier inscrit
Juvenat