Discussion :

[Anthony_office]

Bonjour,

Je souhaite créer une macro qui me permet de coller automatiquement 3 fichiers à la suite.
Jusque là j'ai réussi mon problème c'est que je n'arrive pas à supprimer pour chacun la ligne des titres.
Je vous joins mon code. Merci par avance de votre aide
Anthony

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
70
71
72
Sub Traitement()
'
' Traitement Macro
'
 
'
    Sheets("BDD").Select
    Range("A2").Select
   Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Workbooks.Open Filename:= _
        "P:\Formation Excel\Fichier 1.xlsx"
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete
    Selection.EntireRow.Delete
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Base Flux PS.xlsm").Activate
    Sheets("BDD").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Selection.End(xlDown).Offset(1, 0).Select
     Application.CutCopyMode = False
     Workbooks("Fichier 1.xlsx").Close False
 
      Workbooks.Open Filename:= _
        "P:\Formation Excel\Fichier 2.xlsx"
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete
    Selection.EntireRow.Delete
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Base Flux PS.xlsm").Activate
    Sheets("BDD").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Selection.End(xlDown).Offset(1, 0).Select
     Application.CutCopyMode = False
     Workbooks("Fichier 2.xlsx").Close False
 
      Workbooks.Open Filename:= _
        "P:\Formation Excel\Fichier 3.xlsx"
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete
    Selection.EntireRow.Delete
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Base Flux PS.xlsm").Activate
    Sheets("BDD").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Selection.End(xlDown).Offset(1, 0).Select
     Application.CutCopyMode = False
     Workbooks("Fichier 3.xlsx").Close False
 
End Sub

[jerome.vaussenat]

Salut,

Deux remarques pour commencer :
Quand tu postes du code, pense à utiliser la balise # dans la barre d'outils. Ca rend to poste plus lisible
Au niveau de la programmation VBA, moins tu utilises les instruction Select, mieux c'est. C'est une manière différente de coder mais ton code sera plus rapide.

Pour ce qui t'intéresse, une idée con peut être mais. Au lieu de chercher à supprimer les lignes de titre dans ton tableau de synthèse. Pourquoi ne pas traiter le problème en amont ? Ne les sélectionne pas quand tu fais la copie :

Code :

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

1
2
3
4
5
...
Range("A2").Select
Selection.CurrentRegion.Select
Selection.Copy
...

ps : avec la balise # ton code s'affiche comme celui ci dessus !

En espérant que çà réponde à ton problème.

[Anthony_office]

Bonjour Jérôme

Merci beaucoup pour ta réponse, désolé s'était la première fois que je posté ce genre de chose.
J'ai du mal à comprendre ce que je dois exactement faire.

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
70
71
72
Sub Traitement()
'
' Traitement Macro
'
 
'
    Sheets("BDD").Select
    Range("A2").Select
   Rows("2:2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Delete Shift:=xlUp
    Workbooks.Open Filename:= _
        "P:\Formation Excel\Fichier 1.xlsx"
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete
    Selection.EntireRow.Delete
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Base Flux PS.xlsm").Activate
    Sheets("BDD").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Selection.End(xlDown).Offset(1, 0).Select
     Application.CutCopyMode = False
     Workbooks("Fichier 1.xlsx").Close False
 
      Workbooks.Open Filename:= _
        "P:\Formation Excel\Fichier 2.xlsx"
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete
    Selection.EntireRow.Delete
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Base Flux PS.xlsm").Activate
    Sheets("BDD").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Selection.End(xlDown).Offset(1, 0).Select
     Application.CutCopyMode = False
     Workbooks("Fichier 2.xlsx").Close False
 
      Workbooks.Open Filename:= _
        "P:\Formation Excel\Fichier 3.xlsx"
    Rows("1:6").Select
    Range("A6").Activate
    Selection.Delete Shift:=xlUp
    Range("B1").Select
    Selection.End(xlDown).Select
    Selection.EntireRow.Delete
    Selection.EntireRow.Delete
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.Copy
    Windows("Base Flux PS.xlsm").Activate
    Sheets("BDD").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
     Selection.End(xlDown).Offset(1, 0).Select
     Application.CutCopyMode = False
     Workbooks("Fichier 3.xlsx").Close False
 
End Sub

[Anthony_office]

Bonjour Riaolle,

Mon problème c'est que j'utilise l'enregistreur de macro, est que j'utilise le raccourci clavier CTRL* afin de sélectionner l'ensemble du tableau quelque soit le nombre de ligne, pour faire cela il me faut absolument la ligne des titres.

[Anthony_office]

Je vais rester sur une tâche manuelle (je supprimerai les titres manuellement).
Je n'arrive pas à mettre le code en place.

Merci quand même pour votre aide

[riaolle]

Bonjour,
J'imagine que tu utilises l'enregistreur de macro pour générer ce code. C'est bien ! Mais il faut adapter le code ensuite. Notamment : on évite au maximum d'utiliser Select/Selection/Activate/ActiveSheet... Il vaut mieux directement travailler sur les objets.
Ensuite, je créerais bien une variable par feuille sur laquelle tu travailles pour l'utiliser pour préciser sur quelle feuille on veut faire les différentes actions. Car quand tu écris Range("A1") tout seul, on travaille sur la feuile active et là vu qu'il y a plusieurs feuiles qui sont actives chacunes leur tour, on risque de se tromper à un moment donné.
PasteSpecial s'utilise sur une cellule et pas une feuille.

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
Sub Traitement()
 '
 ' Traitement Macro
 '
 
 Dim bdd As Worksheet
 Set bdd =  Windows("Base Flux PS.xlsm").Sheets("BDD")
 Dim fichier1 As Worksheet
 Dim fichier1 As Worksheet
 Dim fichier3 As Worksheet
 
 bdd.Rows("2:" & Range("A2").End(xlDown).Row).Delete Shift:=xlUp
 Workbooks.Open Filename:="P:\Formation Excel\Fichier 1.xlsx"
 Set fichier1 = Workbooks("Fichier 1.xlsx").Sheets(1)
 fichier1.Range("A6").Delete Shift:=xlUp             'là on supprime pas toute la ligne, est-ce normal?
 fichier1.Range("B1").End(xlDown).EntireRow.Delete
 
 fichier1.Range("A1").CurrentRegion.Copy
 bdd.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
 Workbooks("Fichier 1.xlsx").Close False
 
 Workbooks.Open Filename:="P:\Formation Excel\Fichier 2.xlsx"
 Set fichier2 = Workbooks("Fichier 2.xlsx").Sheets(1)
 fichier2.Range("A6").Delete Shift:=xlUp             'là on supprime pas toute la ligne, est-ce normal?
 fichier2.Range("B1").End(xlDown).EntireRow.Delete
 fichier2.Range("B1").End(xlDown).EntireRow.Delete    'est-ce normal qu'il y ait encore une suppression de ligne
 fichier2.Range("A1").CurrentRegion.Copy
 bdd.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
 Workbooks("Fichier 2.xlsx").Close False
 
 Workbooks.Open Filename:="P:\Formation Excel\Fichier 3.xlsx"
 Set fichier3 = Workbooks("Fichier 3.xlsx").Sheets(1)
 fichier3.Range("A6").Delete Shift:=xlUp             'là on supprime pas toute la ligne, est-ce normal?
 fichier3.Range("B1").End(xlDown).EntireRow.Delete
 fichier3.Range("B1").End(xlDown).EntireRow.Delete   'est-ce normal qu'il y ait encore une suppression de ligne?
 fichier3.Range("A1").CurrentRegion.Copy
 bdd.Range("A1").End(xlDown).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
 :=False, Transpose:=False
 Application.CutCopyMode = False
 Workbooks("Fichier 3.xlsx").Close False
 
 End Sub

Jusque là j'ai réussi mon problème c'est que je n'arrive pas à supprimer pour chacun la ligne des titres.

Peux-tu être plus précis? Est-ce une ligne en particulier? Pourquoi n'utilises-tu pas Delete comme tu le fais déjà dans le code que tu présentes ici?
As-tu essayé l'enregistreur de macro?