Discussion :

[acine]

Bonsoir
C'est encore moi. J'ai des informations relatives à des individus consignées dans des classeurs différents(A, B, ..., Z); un classeur par individu et une feuille par classeur.

Je souhaite copier automatiquement, sans ouvrir les classeurs, une plage de cellule dans un classeur d'analyse. La plage à copier a la même référence dans chaque classeur (A1:G50, par exemple).

Merci pour votre aide.

[Theze]

Bonsoir,

Teste ce qui suit pour voir si cela convient. Il te faut tout d'abords adapter le chemin du dossier et le nom des feuilles. Fait un test sur un classeur vierge :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
 
Sub Recup()
 
    Dim Fichier As String
    Dim Chemin As String
    Dim DL As Long
 
    'adapter le chemin où se trouvent les classeurs
    Chemin = "D:\"
 
    'récupère tous les classeurs Excel .xls (pas les autres, donc à adapter)
    Fichier = Dir(Chemin & "*.xls")
 
    'boucle sur tous les classeurs afin de récupérer les valeurs dans la feuille 1 ("Feuil1")
    'adapter le nom de la feuille
    Do While Fichier <> ""
 
        With Worksheets("Feuil1")
 
            DL = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
 
        End With
 
        'récupère les valeurs par formules dans la feuille "Feuil2"
        '(qui sert d'intermédiaire car les adresses de plages doivent correspondre)
        Worksheets("Feuil2").Range("A1:G50").Formula = "='" & Chemin & "[" & Fichier & "]Feuil1'!A1:G50"
 
        'et vire les formules pour ne garder que les valeurs
        Worksheets("Feuil2").Range("A1:G50").Value = Worksheets("Feuil2").Range("A1:G50").Value
 
        'récupère ensuite sur la feuille "Feuil1" les unes à la suite des autres
        Worksheets("Feuil1").Range("A" & DL & ":G" & DL + 49) = Worksheets("Feuil2").Range("A1:G50").Value
 
        'fichier suivant
        Fichier = Dir
 
    Loop
 
End Sub

Hervé.

[acine]

Bonsoir Hervé et merci pour votre intérêt pour mon problème.

Je dois faire quelques précisions:
1) les documents sont des bases de données extraites, donc l'intitulé de la feuille 1 qui contient les informations est une série de de 20 chiffre. Le plus important est que chaque classeur ne contient qu'un fichier.
2) Je souhaite extraire la même partie de chaque classeur pour les aligner les unes après les autres dans ma page d'analyse qui est dans un classeur séparé.

J'ai modifié ce code comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Sub Recup()
 
    Dim Fichier As String
    Dim Chemin As String
    Dim DL As Long
 
    'adapter le chemin où se trouvent les classeurs
    Chemin = " C:\Users\CONDE\Documents\Article_encours_perso\Misalignement\doc&art_rev\compData\"
 
 
    'récupère tous les classeurs Excel .xls (pas les autres, donc à adapter)
    Fichier = Dir(Chemin & "*.xls")
 
    'boucle sur tous les classeurs afin de récupérer les valeurs dans la feuille 1 ("Feuil1")
    'adapter le nom de la feuille
    Do While Fichier <> ""
 
        With Worksheets("Feuil1")
 
            DL = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 'sur colonne A
 
        End With
 
        'récupère les valeurs par formules dans la feuille "Feuil2"
        '(qui sert d'intermédiaire car les adresses de plages doivent correspondre)
        Worksheets("Feuil2").Range("A1:G50").Formula = "='" & Chemin & "[" & Fichier & "]Feuil1'!A1:G50"
 
        'et vire les formules pour ne garder que les valeurs
        Worksheets("Feuil2").Range("A1:G50").Value = Worksheets("Feuil2").Range("A1:G50").Value
 
        'récupère ensuite sur la feuille "Feuil1" les unes à la suite des autres
        Worksheets("Feuil1").Range("A" & DL & ":G" & DL + 49) = Worksheets("Feuil2").Range("A1:G50").Value
 
        'fichier suivant
        Fichier = Dir
 
    Loop
 
End Sub

En y ajoutant juste le chémin, mais il n'a pas tourné. Il me signale une erreur sur la ligne:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Fichier = Dir(Chemin & "*.xls")

S'il faut que je fournisse manuellement le nom de chacun des 67 fichiers, cela sera honoreux en temps, il me semble.
Encore grand merci pour votre aide.

[Theze]

Bonsoir,

Si tes fichiers sont des .xlsx, effectivement ça le marche pas c'est pour cette raison que j'ai marqué en commentaire qu'il faut adapter.
Teste de la façon suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
Fichier = Dir(Chemin & "*.xls*")

Hervé.