Discussion :

[parmi]

J'ai donné le nom "Résultat" à la feuille dans laquelle on copie les données les unes en-dessous des autres

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
40
41
42
Sub CopieFichiers()
    Dim I As Long, nbLignes As Long
    Dim LigneSource As Long, ColonneSource As Long, LigneDest As Long
    Dim Chemin As String, Fichier As String
 
    On Error GoTo Erreur
 
    'Le chemin doit finir pas un "\"
    Chemin = Sheets("paramètre").Range("D5")
    If Right(Chemin, 1) <> "\" Then Chemin = Chemin & "\"
 
    nbLignes = Sheets("paramètre").Cells(Rows.Count, "D").End(xlUp).Row
 
    For I = 10 To nbLignes
        'lecture du nom du fichier
        Fichier = Sheets("paramètre").Range("D" & I)
        'Vérifie que le fichier existe
        If Dir(Chemin & Fichier) <> "" Then 'existe
            'ouvre le fichier
            Workbooks.Open Chemin & Fichier
            'détermine le nombre de lignes et colonnes à copier en tenant compte qu'il y a des entêtes en ligne 1
            LigneSource = ActiveWorkbook.Sheets("Synthèse").Cells(Rows.Count, "A").End(xlUp).Row
            ColonneSource = ActiveWorkbook.Sheets("Synthèse").Cells(1, Columns.Count).End(xlToLeft).Column
            'détermine la 1ere ligne vide dans le fichier maître
            LigneDest = ThisWorkbook.Sheets("Résultat").Cells(Rows.Count, "A").End(xlUp).Row
            'copie les données telles quelles avec format, formules,...
            ActiveWorkbook.Sheets("Synthèse").Range(Cells(2, 1), Cells(LigneSource, ColonneSource)).Copy _
                ThisWorkbook.Sheets("Résultat").Range("A" & LigneDest)
            'ferme le fichier qu'on vient de copier sans sauvegarde
            ActiveWorkbook.Close False
        Else
            MsgBox "Le fichier " & Fichier & " n'existe pas dans le répertoire " & Chemin
        End If
    Next
 
    MsgBox "Terminé"
 
    Exit Sub
Erreur:
    MsgBox Err.Number & vbCrLf & Err.Description
 
End Sub

[yann7630]

merci de ta réponse

entre temps et apres beaucoup de recherche et tentative j'ai fait ce code

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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub Bouton15_Cliquer()
 
 Dim wkA As Workbook, wkB As Workbook
 Dim chemin As String, fichier As String
 
 
 Dim FL1 As Worksheet, Cell As Range, Plage As Range
 Dim Var1
 
    Set FL1 = Worksheets("Paramètres")
    With FL1
        'Détermination de la plage de cellules à lire
        'Peut s'écrire en utilisant l'objet range de la plage
        'For Each Cell In .Range("B3:E15")
 
        'ou en utilisant l'objet Plage (range) de la plage
        Set Plage = .Range("D20:D40")
        For Each Cell In Plage
 
            'Valeur de la cellule lue
            Var1 = Cell.Value
 
      Set wkA = ThisWorkbook
 
      chemin = Sheets("Paramètres").Range("D11").Value
      fichier = Var1
      Workbooks.Open chemin & fichier
      Set wkB = ActiveWorkbook
      wkB.Sheets("Synthèse").Copy after:=wkA.Sheets(1)
      wkB.Close True 'ferme et enregistre le classeur B
 
 
       Next
    End With
    Set FL1 = Nothing
    Set Plage = Nothing
 
End Sub
 
 
' Dim wkA As Workbook, wkB As Workbook
' Dim chemin As String, fichier As String
 
' 'classeur A qui contient la macro
' Set wkA = ThisWorkbook
 
' 'chemin ou se trouve le fichier B
 
' chemin = Sheets("Paramètres").Range("D11").Value
 
 
' 'nom du fichier B
' fichier = Sheets("Paramètres").Range("D20").Value
 
 
' 'ouvre le fichier B
 
'  Workbooks.Open chemin & fichier
 
' 'met en variable le classeur B
' Set wkB = ActiveWorkbook
 
' 'copie la feuille "feuil1" du classeur A avant la feuille 1 dans le classeur B
' wkB.Sheets("Synthèse").Copy before:=wkA.Sheets(1)
 
' MsgBox ("La feuille est maintenant copiée") 'message pour dire que la feuille est copiée.
 
' wkB.Close True 'ferme et enregistre le classeur B
' End Sub

celui ci fonctionne me reste juste une erreur qui vient du fait que la plage de la boucle est plus grande que la liste de mes fichier
y a t'il un code a rentre pour dire d'arreter quand la cellule est vide

et a renommer mes feuilles importer par le nom du fichier

je n'ai pas reussi a trouver sur les forum ces 2 solutions

merci de ton aide

[parmi]

Ceci détermine la plage que tu donnes à ta boucle

Set Plage = .Range("D2040")

Ceci détermine le nombre de lignes de la plage

Code :

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

1
2
nbLignes = Sheets("paramètre").Cells(Rows.Count, "D").End(xlUp).Row
For I = 10 To nbLignes

C'aurait pu être aussi, selon ta méthode du For Each

Code :

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

1
2
nbLignes = Sheets("paramètre").Cells(Rows.Count, "D").End(xlUp).Row
Set Plage = .Range("D20:D" & nbLignes)

[yann7630]

Merci
j'ai modifié mon code avec ta modif pour la plage et ca fonctionne nikel

tu aurais une idée pour renommer chaque feuilles copier par le nom du fichier d'ou il est issu

exemple
synthèse du fichier suivi 1.xlsm serait suivi 1
synthèse du fichier suivi 2.xlsm serait suivi 2
etc..

[parmi]

Si tes fichiers se nomment toujours de la façon que tu dis.

Code :

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

1
2
3
4
5
Dim Tablo
.....
Tablo = Split(wkB.name, ".")  'sépare le nom de fichier au point sans conserver ce point
wkA.Activesheet = Tablo(0)  'à tester si l'onglet est bien celui actif au moment de la copie
wkB.Close True

À tester sur un fichier pour voir si ça nomme le bon onglet.
Si ça nomme le mauvais onglet, il faudra peut-être faire un Activate sur wkA, renommer l'onglet puis fermer wkB ou encore fermer l'wkB avant de renommer...
Sous 2013, dans certains cas (lorsqu'un UserForm est ouvert, entre autres), l'onglet visible à l'oeil nu n'est pas nécessairement celui qui est actif... Sous 2010, je ne sais pas...

[yann7630]

Bonsoir

Parmi sa n'a pas marché
par contre j'ai trouvé le code qui me manqué
voici au complet si jamais sa interresse un futur develloppeur en herbe comme moi

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
40
41
42
43
44
45
46
47
Sub Bouton15_Cliquer()
 Dim wkA As Workbook, wkB As Workbook
 Dim Chemin As String, Fichier As String
 Dim I As Long, nbLignes As Long
 Dim FL1 As Worksheet, Cell As Range, Plage As Range
 Dim Var1
 
    Set FL1 = Worksheets("Paramètres")
    With FL1
        'Détermination de la plage de cellules à lire
        'en utilisant l'objet Plage (range) de la plage
        'plage situé feuille "Paramètres" colonne D à partir de D20
 
        nbLignes = Sheets("paramètres").Cells(Rows.Count, "D").End(xlUp).Row
        Set Plage = .Range("D20:D" & nbLignes)
 
        For Each Cell In Plage
            'Valeur de la cellule lue
             Var1 = Cell.Value
 
      Set wkA = ThisWorkbook
 
      ' détermination des fihiers à importer
      ' chemin feuille paramètres cellule D11
      ' fichiers suivant la liste plage à partir de D20
      ' attention chemin sans la dernier "\" et fichier sans l'extension
      ' prévu pour fichiers ".xlsm"
      Chemin = Sheets("Paramètres").Range("D11").Value
      Fichier = Var1
      Workbooks.Open Chemin & "\" & Fichier & ".xlsm"
      Set wkB = ActiveWorkbook
 
      ' copie de la feuille "Synthèse" du fichier B à importer dans fichier A ou il y a la macro
     wkB.Sheets("Synthèse").Copy after:=wkA.Sheets(1)
 
     ' renomme la feuille " Synthèse" importé du fichier B par le nom du fichier d'origine sans le ".xlsm"
          ActiveSheet.Name = Left(wkB.Name, Len(wkB.Name) - 5)
      wkB.Close True 'ferme et enregistre le classeur B
 
 
 
       Next
    End With
    Set FL1 = Nothing
    Set Plage = Nothing
MsgBox ("Les feuilles sont maintenant copiées") 'message pour dire que les feuilles sont copiées.
End Sub

merci encore parmi d'avoir pris du temps pour moi

[parmi]

Cette ligne, tu peux la mettre avant ta boucle.
Ça ne sert à rien de refaire un Set en boucle...

Code :

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

Set wkA = ThisWorkbook

Et ça ne sert à rien d'utiliser Var1.
Mets directement Fichier = Cell.Value et élimine Var1 et la ligne où tu mets Fichier = Var1

Bonne continuation

[Menhir]

Le With aussi est inutile vu qu'il ne sert qu'une seule fois ligne 15.

[yann7630]

merci parmi parmi pour les petits détails

Menphis le with a l'air de servir si je l'enleve la macro ne fonctionne plus ou sinon il faut adapté autre chose
mais pour le néophite que je suis il me faut plus de précisions

[Kimy_Ire]

Bonjour bonjour,

Menhir n'a pas dit que le With ne servait à rien mais simplement qu'il ne sert qu'une fois à la ligne n°15.
Ainsi tu peux enlever le

Code :

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

1
2
3
4
5
Set FL1 = Worksheets("Paramètres")
    With FL1
'et puis
    End With
    Set FL1 = Nothing

si tu écris ceci en ligne 15 :

Code :

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

Set Plage = Worksheets("Paramètres").Range("D20:D" & nbLignes)

Bref, j'étais simplement de passage.

Cordialement,
Kimy

[Menhir]

Pour compléter ce qu'a dit Kimy_Ire, un With sert à éviter les répétitions en mettant une sorte de préfixe "provisoirement permanent" (jusqu'au End With).
S'il ne sert qu'une fois, il est inutile dans le sens où il vaut mieux directement mettre son objet là où il est utilisé.

C'est un peu comme si tu créais une variable indexée mais avec un seul élément ou un tableau avec une seule ligne et une seule colonne.

[yann7630]

Merci pour ces précisions
effectivevement avec l'explication je comprend mieux