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

[jeanmi]

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

 

[Compte Supprimé 979]

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

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]

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

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

 

[Compte Supprimé 979]

Salut JeanMi

Oui je déplace bien les fichiers,
en revanche je ne comprends pas bien "il peut y avoir entre 4 et 8 fichiers à chaque fois"

A+

 

[jeanmi]

Salut JeanMi

Oui je déplace bien les fichiers,
en revanche je ne comprends pas bien "il peut y avoir entre 4 et 8 fichiers à chaque fois"

A+

Re

Oui, il y a plusieurs fichiers contenant le nom rechercher, avec des extension différente. il faut donc déplacer tous ces fichier avant de passer au nom suivant donc à la ligne suivante.

 

[Compte Supprimé 979]

Re,

Arf, donc le code n'est pas bon

Voici le correctif

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]

Re,

Arf, donc le code n'est pas bon

Voici le correctif

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