Créer une macro de concatenation de fichier

Version imprimable

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:

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

11/05/2017, 09h44
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:

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.

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:

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
Citation:

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?

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:

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

11/05/2017, 10h09
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.
12/05/2017, 10h59
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