[VBA] Copie de certains fichiers d'un dossier vers un autre

bonjour à toutes et à tous,

cela fait quelques jours que je galère à programmer une tache de copie de fichiers mal grès quelques idées pompées sur le forum ci ou là.

Le but de mon fichier est de récapituler des données de rapport de contrôle tous situés dans un même dossier.

Le dossier contenant les fichiers est changeant mais je maîtrise l'indexation vers son lien.

Dans ce dossier je veux ouvrir que les fichiers .xls qui ont un nom numérique à partir de 1.xls ( pas les fichier essai.xls ou 0.xls...) sachant que le nombre de fichier varie d'une fabrication à l'autre. La copie des données contenue dans les différents fichiers se fera avec certaines conditions que je maîtrise déjà.

J'ai essayé ce code:

Chemin = "W:\tridim\Rapport\Client\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\" 'lien vers le dossier contenant les fichiers à copier, modifiable à souhait
Fichier = Dir(Chemin & "*.xls") 'ouverture des fichiers .xls

    Do While Fichier <> "" 'je comprend cette commande comme étant "faire jusqu'à ce que le dossier soit vide", or le dossier n'est jamais vide

        With Workbooks.Open(Fichier)

            If IsNumeric(ThisWorkbook.Name) And ThisWorkbook.Name <> "0" Then 'si le nom du fichier est numérique et different de 0
                MsgBox "ça marche"
            Else
                MsgBox "ça ne marche pas"
            End If
            .Close
        End With

    Loop

j'obtiens une boucle infinie avec le message "ça ne marche pas" et le même fichier est ouvert.

Toute aide est la bien venue et si c'est pas claire n’hésitez pas à me demander des éclaircissements.

Cordialement,

Bonjour

Code non testé

Sub test()
  chemin = "W:\tridim\Rapport\Client\" & Sheets(1).Range("client") & "\" & Sheets(1).Range("cmd_int") & "\" & Sheets(1).Range("code_produit") & "\N°OF" & Sheets(1).Range("of") & "\" 'lien vers le dossier contenant les fichiers à copier, modifiable à souhait
  fichier = Dir(chemin & "*.xls") 'ouverture des fichiers .xls

  Do While fichier <> ""  'Boucle tant que l'on trouve un NOUVEAU fichier
     If Val(fichier) > 0 Then
      MsgBox "Fichier à ouvrir"
      With Workbooks.Open(chemin & fichier)
        ' Traitement du fichier
        .Close
      End With
    Else
      MsgBox "Pas le bon type de fichier"
    End If
    fichier = Dir     ' Va voir s'il existe un autre fichier
  Loop
End Sub

ci joint le fichier en question.

est concerné le module "création_rapport", et la partie "OUVERTURE DES FICHIERS ET COPIE DES VALEURS"

Bonjour Banzai64 et merci pour le message et la réponse proposée.

le code marche je vais pouvoir mettre dans la partie "traitement fichier" la copie des valeurs.

par contre j'ai fait un essai avec des fichiers dont un nommé 1a et il le prend!!! y'aurait-il une condition qui permettrait de ne prendre que les fichiers à nom numérique compris entre 1 et 10000 par exemple.

encore merci et bon appétit

Bonjour

Pas de limite supérieure avec ce code

Minimum 1 maximum ......

If Val(fichier) > 0 And IsNumeric(Left(fichier, Len(fichier) - 4)) Then
  MsgBox "Fichier à ouvrir"

Banzai64 a écrit :

Bonjour

Pas de limite supérieure avec ce code

Minimum 1 maximum ......

If Val(fichier) > 0 And IsNumeric(Left(fichier, Len(fichier) - 4)) Then
  MsgBox "Fichier à ouvrir"

super banzai64 avec cette nouvelle condition tout fonctionne comme je veux. juste une dernière question: comment récupérer le nom du fichier ouvert? je vais alterner entre ce fichier ouvert et le fichier ou je dois copier les valeurs

Bonjour

Elhadj a écrit :

comment récupérer le nom du fichier ouvert?

Celui que tu ouvres : fichier

Celui qui est ouvert (celui contenant la macro) : ThisWorkbook.Name

merci beaucoup pour ton aide

Si t'as encore un peu de temps, pourrais -tu s'il te plait m'expliquer le code (Left(fichier, Len(fichier) - 4)?

Bonjour

(Left(fichier, Len(fichier) - 4)

On récupère la partie gauche du fichier sans l'extension

Exemple si le fichier s'appelle "458.xls" on récupère juste "458"

Len(fichier) = 7

Len(fichier) - 4 ==> 7 -4 = 3

(Left(fichier, Len(fichier) - 4) ==> Left( "458.xls, 7 - 4) ==> Left( "458.xls, 3) ==> "458"

Merci pour la réponse

sans vouloir abuser j'ai enrichie ton code avec ceci:

a = 20
    Do While Fichier <> ""  'Boucle tant que l'on trouve un NOUVEAU fichier

        If Val(Fichier) > 0 And IsNumeric(Left(Fichier, Len(Fichier) - 4)) Then
            With Workbooks.Open(Chemin & Fichier)

                For j = 1 To desicotes

                    Sheets(1).Cells(6 + 2 * j, 7).Copy  'COPIES VALEURS
                    Windows(nom_rapport & ".xlsm").Activate 'ligne qui bug
                    Sheets(1).Range("A" & a).Value = Fichier
                    Sheets(1).Cells(a, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
                    Windows(Fichier & ".xls").Activate

                Next
                .Close
            End With
        a = a + 1
        End If

        Fichier = Dir     ' Va voir s'il existe un autre fichier

    Loop

mais j'ai un bug avec la ligne où je fais appel au fichier contenant la macro. je précise qu'en début de programme j'ai bien marqué

Dim nom_rapport As Variant
nom_rapport = ThisWorkbook.Name

je vais continuer à chercher de mon côté mais si dés fois la raison te sauterai aux yeux!!!

et encore merci

c'est bon j'ai trouvé c'était dû aux extensions que j'avais rajouté aux noms de fichiers, en les enlevant ça marche beaucoup mieux lol

je termine de mettre les conditions de copie puis j'irai à la pêche aux infos sur la mise en forme conditionnelle

Bonjour

Comme je n'arrive pas à cerner ce que tu veux faire exactement

Essayes

  a = 20
  Do While fichier <> ""  'Boucle tant que l'on trouve un NOUVEAU fichier
    If Val(fichier) > 0 And IsNumeric(Left(fichier, Len(fichier) - 4)) Then
      With Workbooks.Open(Chemin & fichier)
        ThisWorkbook.Sheets(1).Range("A" & a) = fichier
        For j = 1 To desicotes
          .Sheets(1).Cells(6 + 2 * j, 7).Copy  'COPIES VALEURS
          ThisWorkbook.Sheets(1).Cells(a, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        Next j
        .Close
      End With
      a = a + 1
    End If
    fichier = Dir     ' Va voir s'il existe un autre fichier
  Loop

Banzai64 a écrit :

Bonjour

Comme je n'arrive pas à cerner ce que tu veux faire exactement

Essayes

  a = 20
  Do While fichier <> ""  'Boucle tant que l'on trouve un NOUVEAU fichier
    If Val(fichier) > 0 And IsNumeric(Left(fichier, Len(fichier) - 4)) Then
      With Workbooks.Open(Chemin & fichier)
        ThisWorkbook.Sheets(1).Range("A" & a) = fichier
        For j = 1 To desicotes
          .Sheets(1).Cells(6 + 2 * j, 7).Copy  'COPIES VALEURS
          ThisWorkbook.Sheets(1).Cells(a, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        Next j
        .Close
      End With
      a = a + 1
    End If
    fichier = Dir     ' Va voir s'il existe un autre fichier
  Loop

je copie de "fichier" vers "nom_rapport" et pour cela j'alterne entre les deux documents, et comme marqué plus haut j'ai trouvé l'erreur, désolé de t'avoir alerté pour rien

encore merci

La copie des côtes s'est très bien passée mais j'ai du mal à sélectionner une plage de cellule si tu connais la solution ?

Range("B20:X23").Select

je souhaiterai ecrire cette ligne avec la variable desicotes+1 = numéro de colonne et a= numéro de ligne. cela devrait donner quelque chose comme

Range("B20:"desicotes+1 & a")

mais pas de bol ça ne marche et je commence à saturer là.

mon programme est maintenant fini dans les grandes lignes il ne me manque plus qu'a faire la mise en forme et mise en forme conditionnelle.

encore merci

Bonjour

Ton code pourrait ressembler à ça

      With Workbooks.Open(Chemin & fichier)
        ThisWorkbook.Sheets(1).Range("A" & a) = fichier
        With .Sheets(1)
          .Range(.Range("B20"), .Cells(a, desicotes + 1)).Copy
        End With
        ThisWorkbook.Sheets(1).Cells(a, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        .Close
      End With

Si pas ça, il faut ton fichier principal et au moins un fichier de donnée

Tu expliques ce que tu veux y récupérer et où tu veux l'écrire

Banzai64 a écrit :

Bonjour

Ton code pourrait ressembler à ça

      With Workbooks.Open(Chemin & fichier)
        ThisWorkbook.Sheets(1).Range("A" & a) = fichier
        With .Sheets(1)
          .Range(.Range("B20"), .Cells(a, desicotes + 1)).Copy
        End With
        ThisWorkbook.Sheets(1).Cells(a, 1 + j).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
        .Close
      End With

Si pas ça, il faut ton fichier principal et au moins un fichier de donnée

Tu expliques ce que tu veux y récupérer et où tu veux l'écrire

voici le fichier en pièces jointes j'y ai expliqué en détail les 4 actions qui me restent à faire.

encore merci

Bonjour à toi aussi

A tester

N'utilises pas le bouton "Citer" (cela pollue les messages) mais utilises le bouton "Répondre"

Bonjour,

Désolé je viens de réaliser que je ne t'ai pas dis bonjour effectivement, mes plus plates excuses

tout fonctionne comme voulu (tri décroissant au lieu de croissant mais je crois pouvoir corriger ça) à l'activation de la macro donc je vais lire et tenter de décoder ce que t'as écris.

Vraiment merci,

Bonjour

Tu as bien noté

* Tri personalisé de la zone selectionné par valeurs de la colonne A du plus grand au plus petit

C'est un tri décroissant

Pour avoir un tri croissant (du plus petit au plus grand)

Modifies la partie surlignée

.Sort Key1:=Range("A20"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal