Discussion :

[Nairolf87]

Bonjour,
Je tente de créer une macro me permettant d'aller chercher des lignes dans différents fichiers excel et de les recopier dans un fichier de destination. J'ai élaboré un début de macro mais mon pb est du fait que quand il va chercher le 2 ème fichier, cela les recopies sur les lignes du 1 er fichier et ainsi de suite...

Je n'arrive pas à résoudre ce pb merci de m'aider.

Cdlt

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
 
Private Sub copiecollesave_Click()
Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "FA.xls"
Workbooks.Open Rep & FichS
 
With Workbooks(FichS)
.Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
Workbooks(FichD).Save
Workbooks(FichS).Close
End With
 
Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "SB.xls"
Workbooks.Open Rep & FichS
 
With Workbooks(FichS)
 
.Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
Workbooks(FichD).Save
Workbooks(FichS).Close
 
 
End With
Application.ScreenUpdating = True
 
Application.ScreenUpdating = False
Rep = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\"
FichD = ActiveWorkbook.Name
FichS = "MJ.xls"
Workbooks.Open Rep & FichS
 
With Workbooks(FichS)
 
.Sheets("Feuil1" ).Range("A2:H65536" ).Copy _
Workbooks(FichD).Sheets("Feuil1" ).Range("A65536" ).End(xlUp).Offset(1, 0)
Workbooks(FichD).Save
Workbooks(FichS).Close
 
End With
Application.ScreenUpdating = True
 
 
 
 
End Sub

[DeaD78]

Bonjour,

Pourrais-tu me donner quelques infos supplémentaires afin de régler ce problème (et surtout rendre ton compte optimal) ?

Copies-tu toujours les infos de FichS, Range("A2:H65536" ) vers FichD ?
Quel est le nom de FichD ?

Ici, tu as dit que c'est ActiveWorkbook. ActiveWorkbbok est toujours le classeur actif (le dernier ouvert dans ton cas, donc bug). De plus, je ne suis pas complètement sûr que ton copy fonctionne bien.

Enfin, combien y'a-t-il de fichiers dans ton répertoire ? Seulement ceux que tu veux ouvrir ? Je te propose un petit code après la pause déjeuner et tu me dis si j'ai bien cerné le problème (j'ai bien des réponses aux questions que je viens de poser mais il me faut confirmation).

Donc, autant "cleaner" ton code et le rendre fonctionnel non?

[DeaD78]

Voilà donc ce que tu recherches :

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
Sub Macro()
 
'Disons que tu places ta macro dans un fichier destination nommé Test.xls disposé sur le bureau ou autres que tu dois ouvrir pour la lancer
    Dim FichD As String
    Dim FichS As Long
 
    FichD = "Test"
 
    Application.ScreenUpdating = False
    With Application.FileSearch
        .NewSearch
        .RefreshScopes
        .LookIn = "C:\Documents and Settings\desbfl01\Mes documents\Exemple VBA\" 'Tous les fichiers du répertoire sont passés en revue
        .Filename = "*.xls"
        .SearchSubFolders = False
        .Execute
        For Ctr = 1 To .FoundFiles.Count
            FichS = Ctr
            Workbooks.Open (.FoundFiles(FichS)) 'Ouverture
            Sheets("Feuil1").Range("A2:" & Range("H65536").End(xlUp).Address).Copy 'Copie
            ActiveWorkbook.Close            
            Workbooks(FichD).Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0).Activate
            ActiveSheet.Paste 'Collage
        Next
    End With
    Range("A1").Activate
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
 
End Sub

C'est ce que tu cherchais à faire non ?

Je viens de tester la macro, elle fonctionne. Il faut que tu changes dedans le nom de ton fichier de destination qui est celui comportant la macro. J'ai admis qu'il y avait autant de valeur dans les colonnes A à H. Lors de la copie, la macro va de A2 jusqu'à la dernière ligne remplie en H, ce qui est logique s'il y a autant de valeurs dans chaque colonne.

Dis-moi si ça répond à tes attentes ou si tu as besoin de certaines modifications pour répondre à tes attentes.

Bonne chance pour la suite !

EDIT : le code est donc "clean". Les screenupdate sont au bon endroit, pas de Select inutiles, fermeture des classeurs après traitement etc...

[Nairolf87]

Salut
Dans un premier temps merci beaucoup, ton code est bcp plus simplifié et professionnel que le mien !


Je l'ai essayé, il va très bien. Mais peux tu m'expliqué qu'es ce qui fait qu'il va coller les cellules de A à H sur la premiere cellule vide ???


Merci encore

[DeaD78]

Re,

et ben de rien

Sinon, pour répondre à ta question, cette ligne

Code :

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

Sheets("Feuil1").Range("A2:" & Range("H65536").End(xlUp).Address).Copy 'Copie

va chercher dans la feuil1 du classeur actif (celui venant d'être ouvert), la plage allant de A2 jusqu'à la dernière cellule non vide de H puis la copie.

Ensuite, cette ligne

Code :

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

Workbooks(FichD).Sheets("Feuil1").Range("A65536").End(xlUp).Offset(1, 0).Activate

va dans la feuille1 du classeur destination puis sélectionne (active en vrai) la cellule de la colonne A suivant la dernière cellule non vide de cette même colonne. Après cela, on y colle ce qu'on avait en copie grâce à

Code :

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

ActiveSheet.Paste

Voilà pour le principe général. Ce qui t'importe, je pense, c'est

Code :

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

Range("A65536").End(xlUp)

Cela représente la dernière celulle non vide de la colonne A. Si tu remplaces A par H dans cette ligne, ça sera la dernière cellule de la colonne H non vide.

Code :

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

Range("A65536").End(xlUp).Offset(1, 0).Activate

Cela permet donc de trouver la dernière cellule non vide de A et de se placer sur celle juste en-dessous grâce à l'offset. C'est donc comme ça qu'on colle sur la première cellule vide.

en tout cas, bonne chance pour la suite et pense au petit