Discussion :

[Manu_111]

Bonjour à tous,

J'ai crée une petite macro qui copie les données d'un classeur excel puis les collent sur une autre classeur excel.

Mon pb est qu'à chaque fois que je lance la macro, j'ai le message du presse papiers qui me demande si je veux sauvegarder les données. Je suis obligé de cliquer sur oui à chaque fois.

Connaissez vous un moyen sous VBA pour indiquer à la macro de cliquer sur oui à chaque fois?

Merci d'avance. Je ne suis pas du tout un as sous VBA. Le code que j'ai écrit doit surement pouvoir être modifié
Manu

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
Sub Regroupement()
 
Application.ScreenUpdating = False
 
Sheets("Feuil1").Select
Range("B4:D4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
 
MonFichier = Dir("C:\Test\*.xls", vbReadOnly)
 
While MonFichier <> ""
    Workbooks.Open "c:\test\" & MonFichier
    Sheets("Feuil1").Select
Trouver:
 ligne = 6
    Do While Sheets("Feuil1").Cells(ligne, 1) <> ""
        ligne = ligne + 1
        If Cells(ligne, 1) = "" Then
        Range("A6").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        End If
    Loop
    Workbooks(2).Close SaveChanges:=False
    GoSub coller
    MonFichier = Dir()
 
Wend
    Cells(ligne + 1, 2).Select
Exit Sub
 
coller:
    ligne = 4
    Do While Sheets("Feuil1").Cells(ligne, 2) <> ""
        ligne = ligne + 1
    Loop
    Cells(ligne, 2).Select
    ActiveSheet.Paste
 
    Return
 
End Sub

[AlainTech]

Je n'ai pas compris l'utilité de cette boucle

Code :

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

1
2
3
4
5
6
7
8
9
10
    ligne = 6
    Do While Sheets("Feuil1").Cells(ligne, 1) <> ""
        ligne = ligne + 1
        If Cells(ligne, 1) = "" Then
        Range("A6").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        End If
    Loop

puisque tu pars toujours de A6 pour ta sélection.
Sans le contenu des fichiers du répertoire test, difficile de se faire une idée.

Quoi qu'il en soit, évite d'utiliser les étiquettes et les Gosub qui ne sont qu'un héritage des antiques Basics.

Pour ton info, voici une petite idée de ce que pourrait être un code un peu plus "propre" et plus orienté objet.

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
Sub Regroupement2()
 
  Dim wbkSource As Workbook
  Dim wbkDest  As Workbook
  Dim wksSource  As Worksheet
  Dim wksDest As Worksheet
  Dim iDerLigne As Long
  Dim strFichSource
 
  Application.ScreenUpdating = False
 
  Set wbkDest = ThisWorkbook
  Set wksDest = wbkDest.Sheets("Feuil1")
  iDerLigne = wksDest.[B4].End(xlDown).Row
  Range(wksDest.[B4], wksDest.Cells(iDerLigne, 4)).Clear
  iDerLigne = 4
 
  strFichSource = Dir("C:\Test\*.xls", vbReadOnly)
 
  While strFichSource <> ""
    Set wbkSource = Workbooks.Open("c:\test\" & strFichSource)
    Set wksSource = wbkSource.Sheets("Feuil1")
 
    Range(wksSource.[A6], wksSource.Cells.SpecialCells(xlLastCell)).Copy (wksDest.Cells(iDerLigne + 1, 2))
    iDerLigne = wksDest.Cells.SpecialCells(xlLastCell).Row
    wbkSource.Close SaveChanges:=False
 
    strFichSource = Dir()
 
  Wend
  wksDest.Cells(iDerLigne + 1, 2).Select
 
End Sub

Je ne l'ai pas entièrement testé car je n'ai pas créé de répertoire test avec des fichiers dedans.

A toi de voir ce que tu peux en retirer.

Edit -> je viens de voir que Pierre Fauconnier t'avais répondu dans le même sens que moi.
Pourquoi n'as-tu pas tenu compte de sa réponse?
Evite de poser plusieurs questions dans la même discussion et, surtout, d'en ouvrir une nouvelle quand on t'a déjà répondu dans la première.