Macro - Récupération de données dans plusieurs feuilles et rassemblement en une seule

Version imprimable

Voir 40 message(s) de cette discussion en une page

26/10/2016, 12h59
Duardo

Macro - Récupération de données dans plusieurs feuilles et rassemblement en une seule

Bonjour à tous :)

Grand novice dans le domaine VBA Macro j'aurais pourtant bien besoin d'une belle Macro pour ma faciliter la tache et faire un joli gain de temps.

Si vous êtes prêt je vous explique la chose :
- Récupérer certaines colonnes (différentes pour chaque feuille en valeur et taille) sans leur en-tête
- Fusionner ces colones dans une seule et même feuille avec de nouvelles en-têtes

Exemple :

Feuille 1
En-tête = A1:Prenom B1:Nom C1:Age
Données = A2:Arthur B2:VDK C2:27

Feuille 2
En-tête = A1:Firstname B1:Lastname C1:Poste D1:Age
Données = A2:Morgan B2:Parra C2:Demi-Mélée D2:27

Feuille 3
En-tête = A1:Nom B1:Prenom C1:Poste D1:Age
Données = A2:Guirado B2:Guilhem C2:Talonneur D2:30

Sortie attendue sur nouvelle feuille ou même nouveau classeur
En-tête : A1:Prenom B1:Nom C1:Age
Donnnées: A2:Arthur B2:VDK C2:27 & A3:Morgan B3:Parra C3:28 & A4:Guilhem B4:Guirado C4:30

Je vous serais très reconnaissant si vous pouviez me commenter vos réponses :)
Je reste à votre entière disposition pour toute précision.

Un GRAND MERCI par avance !
26/10/2016, 13h04
Jean-Philippe André

Bonjour,
bienvenue sur DVP :salut:

Il me semble que le simple copier / coller ferait l'affaire non ?

Tu peux regarder avec l'enregistreur de macros
http://fauconnier.developpez.com/tut...istreur-macro/
26/10/2016, 13h09
Duardo

Malheureusement non..

Salut Jean-Philippe :)

Merci pour cette réponse si rapide !!
Malheureusement non mes feuilles étant conséquentes et n'ayant rien à voir avec mon exemple pour la complexité haha

Je peux me retrouver avec près de 80colonnes de 500lignes chacune et n'en souhaiter que 19(colonnes) au final ce qui rend le travail très long et fastidieux alors qu'une macro pourrait faire ça en quelques secondes même pas.

Voilà voilà tout est dit :D
26/10/2016, 13h19
Jean-Philippe André

D'accord, mais du coup c'est comme si je t'avais demande de faire decoller mon avion, alors que je suis encore en train de travailler sur la carlingue...

Afin de permettre a tout le monde de comprendre exactement ce qui doit etre fait, il nous faut une vue si possible exhaustive de ce que tu as.

D'autre part, la logique du forum n'est nullement de pecher pour toi, mais de t'apprendre a pecher.
26/10/2016, 13h43
Duardo

Oui effectivement je comprends ton retour, je pensais seulement que la méthode serait la même (peut importe la taille du document) vu qu'il s'agit de concaténer des colonnes ensemble. Je viens de faire un essai avec l'enregistreur de macro mais en passant par cette solution j'ai besoin de connaitre mes tailles de colonne par avance (pour gérer la copie et ne pas écraser de données) ce qui n'est pas possible dans mon cas.

Vraiment je suis là pour apprendre et pouvoir me débrouiller par la suite plutôt que venir reposer la même question dans quelques semaines.. :)
26/10/2016, 13h47
Jean-Philippe André

On est capable de connaitre le nombre de ligne dans une colonne, donc ce n'est pas un soucis,

quel est ton code actuel du coup ? On va partir de la pour l'adapter.

En faisant quelques recherches je suis tombé sur cette ébauche que j'ai essayé d'adapter mais malheureusement le résultat n'est pas au rendez-vous.

Grace à cette macro je récupère toutes les colonnes de chaque feuilles pour ensuite les fusionner dans une seule et même feuille mais cela ne tient pas compte des en-têtes et donne un rendu plutôt brouillon.
Je souhaiterai arriver à sélectionner des colonnes spécifiques (avec les valeurs de même genre) dans chacune de mes feuilles et obtenir une feuille avec ces colonnes fusionnées entre elles (ex: les noms ensembles, les prénoms ensemble..)

Voici la macro en question :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 Sub Combine() Dim i As Integer Dim xTCount As Variant Dim xWs As Worksheet On Error Resume Next LInput: xTCount = Application.InputBox("The number of title rows", "", "1") If TypeName(xTCount) = "Boolean" Then Exit Sub If Not IsNumeric(xTCount) Then MsgBox "Only can enter number", , "ERROR" GoTo LInput End If Set xWs = ActiveWorkbook.Worksheets.Add(Sheets(1)) xWs.Name = "Combined" Worksheets(2).Range("A1").EntireRow.Copy Destination:=xWs.Range("A1") For i = 2 To Worksheets.Count Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy _ Destination:=xWs.Cells(xWs.UsedRange.Cells(xWs.UsedRange.Count).Row + 1, 1) Next End Sub
Merci pour votre temps passé à m'aider :)

PS : désolé mais je ne suis pas arrivé à mettre la bonne indentation dans ce post pour la macro

26/10/2016, 16h12
Jean-Philippe André

Salut,

2 possibilites dans ce cas :
1/ tu laisses le copier/coller tel que, mais tu prevois de faire une suppression de ligne (celle des en-tete)
2/ tu ne recopies les donnees qu'a partir de la ligne 2
26/10/2016, 16h23
Duardo

Tout d'abord merci pour les balises [CODE] apportées à mon post précédent !!

Le soucis avec les possibilités que tu me proposes est que je n'arrive toujours pas à sélectionner telle ou telle colonne à copier dans chacune de mes feuilles (copier du début de la colonne jusqu'à la dernière cellule utilisée de cette même colonne).

Voilà ce qui me pose vraiment problème, car avec ma macro je fais vraiment un copier/coller brutal qui ne réfléchi pas..

Si tu as une idée de comment résoudre mon problème je suis tout ouïe :)
26/10/2016, 16h42
Jean-Philippe André

Ta zone de copie peut etre modifiee avec ton seconde parametre

Code:

Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), 0).Copy

devenant

Code:

Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), Worksheets(i).Range("IV1").End(xltoLeft).Column-1).Copy
27/10/2016, 10h40
Duardo

Vraiment désolé mais je ne comprends pas comment utiliser ce second paramètre et ne vois pas de réelle différence ici.. :(
27/10/2016, 10h51
Jean-Philippe André

La methode Offset permet d'effectuer un decalage a partir d'une cellule selon des coordonnees (ligne, colonne)

Exemple

Code:

Range("B1").Offset(2,3)

pointera sur la cellule

Code:

Range("E3")

La ligne suivante retourne le numero de la colonne remplie "la plus a droite" sur la ligne 1

Code:

Worksheets(i).Range("IV1").End(xltoLeft).Column

Mis bout a bout, c'est pour dire qu'on part de la cellule, et que le decallage se fait de xTCount lignes et (nombre de colonnes - 1) colonnes

Code:

Worksheets(i).Range("A1").CurrentRegion.Offset(CInt(xTCount), Worksheets(i).Range("IV1").End(xltoLeft).Column-1).Copy

As- tu essaye le code, sans oublie la partie Destination evidemment ?

Finalement je suis arrivé au résultat que je souhaitais (plus ou moins), je retravaille entièrement mes feuilles en réorganisant chaque colonnes c'est top. Tout ça grace à l'enregistreur de macro, le code est "dégueulasse" .... mais cela fonctionne du coup pour l'instant je vais me contenter de ça :)

Cependant, je souhaiterais pouvoir executer ma Macro sur plusieurs feuilles en même temps mais pas sur toutes les feuilles.
Comment faire pour permettre à ma macro de se lancer simultanément sur les Feuil1 Feuil2 Feuil3 Feuil5 Feuil7 ?

Voici l'horreur en question :

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
Sub ALPHA()
'
' ALPHA Macro
'
' Touche de raccourci du clavier: Ctrl+m
'
    Columns("A:A").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Cut
    Range("R1").Select
    ActiveSheet.Paste
    Columns("AE:AE").Select
    Selection.Cut
    Columns("A:A").Select
    ActiveSheet.Paste
    Columns("S:S").Select
    Selection.Cut
    Columns("B:B").Select
    ActiveSheet.Paste
    Columns("U:U").Select
    Selection.Cut
    Columns("C:C").Select
    ActiveSheet.Paste
    Columns("V:V").Select
    Selection.Cut
    Columns("D:D").Select
    ActiveSheet.Paste
    Columns("X:X").Select
    Selection.Cut
    Columns("E:E").Select
    ActiveSheet.Paste
    Columns("AA:AA").Select
    Selection.Cut
    Columns("F:F").Select
    ActiveSheet.Paste
    Columns("AB:AB").Select
    Selection.Cut
    Columns("G:G").Select
    ActiveSheet.Paste
    Columns("AG:AG").Select
    Selection.Cut
    Columns("H:H").Select
    ActiveSheet.Paste
    Columns("T:T").Select
    Selection.Cut
    Columns("I:I").Select
    ActiveSheet.Paste
    Columns("AD:AD").Select
    Selection.Cut
    Columns("J:J").Select
    ActiveSheet.Paste
    Columns("AM:AM").Select
    Selection.Cut
    Columns("K:K").Select
    ActiveSheet.Paste
    Columns("AN:AN").Select
    Selection.Cut
    Columns("L:L").Select
    ActiveSheet.Paste
    Columns("AO:AO").Select
    Selection.Cut
    Columns("M:M").Select
    ActiveSheet.Paste
    Columns("AP:AP").Select
    Selection.Cut
    Columns("N:N").Select
    ActiveSheet.Paste
    Columns("O:O").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Range("A1").Select
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Font.Bold = False
    Selection.Font.Bold = True
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Calibri"
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 9
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    With Selection.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
    End With
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent5
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Range("O1").Select
End Sub

27/10/2016, 12h29
Jean-Philippe André

C'est moche mais ca fonctionne =]

Par la suite on pourra envisager l'optimisation ;)

Pour les autres feuilles, tu peux le faire en faisant une boucle par exemple.

Le code doit egalement etre dans un module :ccool:

J'ai essayé en faisant ça -sauf que ça ne marche pas- :

Code:

1
2
3
4
5
6
7
8
9
 
For Each ws In ActiveWorkbook.Worksheets
    If ws.Name = "Feuil1" And ws.Name = "Feuil2" Then
 
        ' MON CODE HORRIBLE
 
    End If
Next ws
End Sub

27/10/2016, 12h48
Jean-Philippe André

L'idee est la bonne, c'est juste un Or a la place du And

Code:

If ws.Name = "Feuil1" Or ws.Name = "Feuil2" Then

une feuille ne peut pas avoir deux noms a la fois ;)
27/10/2016, 12h55
Duardo

Malheureusement même avec ce OR cela ne fait pas le boulot et fait même n'importe quoi comme avec le AND.

Mince mince mince
27/10/2016, 13h05
Jean-Philippe André
Un element que tu as surement oublie de prendre en compte,

ton code contient seulement des Columns, range etc, mais a aucun moment tu n'as du penser a ajouter ta variable ws pour preciser dans quelle feuille tu travailles
Code:

1 2 3 ws.Columns("A:A").Select ws.Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select 'etc.

Je viens de faire les modifs mais maintenant nouveau soucis !!

Erreur d'exécution '424': Objet requis

Je suis perdu pour le coup..

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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
 
Sub ALPHA_all()
 
    For Each ws In ws.ActiveWorkbook.Worksheets
    If ws.Name = "Feuil1" Or ws.Name = "Feuil3" Then
 
      ws.Columns("A:A").Select
      ws.Range(Selection, ws.ActiveCell.SpecialCells(xlLastCell)).Select
      Selection.Cut
      ws.Range("R1").Select
      ws.ActiveSheet.Paste
      ws.Columns("AE:AE").Select
      Selection.Cut
      ws.Columns("A:A").Select
      ws.ActiveSheet.Paste
      ws.Columns("S:S").Select
      Selection.Cut
      ws.Columns("B:B").Select
      ws.ActiveSheet.Paste
      ws.Columns("U:U").Select
      Selection.Cut
      ws.Columns("C:C").Select
      ws.ActiveSheet.Paste
      ws.Columns("V:V").Select
      Selection.Cut
      ws.Columns("D:D").Select
      ws.ActiveSheet.Paste
      ws.Columns("X:X").Select
      Selection.Cut
      ws.Columns("E:E").Select
      ws.ActiveSheet.Paste
      ws.Columns("AA:AA").Select
      Selection.Cut
      ws.Columns("F:F").Select
      ws.ActiveSheet.Paste
      ws.Columns("AB:AB").Select
      Selection.Cut
      ws.Columns("G:G").Select
      ws.ActiveSheet.Paste
      ws.Columns("AG:AG").Select
      Selection.Cut
      ws.Columns("H:H").Select
      ws.ActiveSheet.Paste
      ws.Columns("T:T").Select
      Selection.Cut
      ws.Columns("I:I").Select
      ws.ActiveSheet.Paste
      ws.Columns("AD:AD").Select
      Selection.Cut
      ws.Columns("J:J").Select
      ws.ActiveSheet.Paste
      ws.Columns("AM:AM").Select
      Selection.Cut
      ws.Columns("K:K").Select
      ws.ActiveSheet.Paste
      ws.Columns("AN:AN").Select
      Selection.Cut
      ws.Columns("L:L").Select
      ws.ActiveSheet.Paste
      ws.Columns("AO:AO").Select
      Selection.Cut
      ws.Columns("M:M").Select
      ws.ActiveSheet.Paste
      ws.Columns("AP:AP").Select
      Selection.Cut
      ws.Columns("N:N").Select
      ws.ActiveSheet.Paste
      ws.Columns("O:O").Select
      ws.Range(Selection, ws.ActiveCell.SpecialCells(xlLastCell)).Select
      Selection.ClearContents
      With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
      End With
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      Selection.Borders(xlEdgeLeft).LineStyle = xlNone
      Selection.Borders(xlEdgeTop).LineStyle = xlNone
      Selection.Borders(xlEdgeBottom).LineStyle = xlNone
      Selection.Borders(xlEdgeRight).LineStyle = xlNone
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
      ws.Range("A1").Select
      ws.Range(Selection, ws.ActiveCell.SpecialCells(xlLastCell)).Select
      With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = False
      End With
      Selection.Borders(xlDiagonalDown).LineStyle = xlNone
      Selection.Borders(xlDiagonalUp).LineStyle = xlNone
      Selection.Borders(xlEdgeLeft).LineStyle = xlNone
      Selection.Borders(xlEdgeTop).LineStyle = xlNone
      Selection.Borders(xlEdgeBottom).LineStyle = xlNone
      Selection.Borders(xlEdgeRight).LineStyle = xlNone
      Selection.Borders(xlInsideVertical).LineStyle = xlNone
      Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
      ws.Range("A1").Select
      ws.Range(Selection, ws.ActiveCell.SpecialCells(xlLastCell)).Select
      Selection.Font.Bold = False
      Selection.Font.Bold = True
      Selection.Font.Bold = False
      With Selection.Font
            .Name = "Calibri"
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
      End With
      With Selection.Font
            .Name = "Calibri"
            .Size = 9
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .TintAndShade = 0
            .ThemeFont = xlThemeFontNone
      End With
      With Selection.Interior
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade = 0
      End With
      With Selection.Font
            .ColorIndex = xlAutomatic
            .TintAndShade = 0
      End With
      ws.Range("A1").Select
      ws.Range(Selection, Selection.End(xlToRight)).Select
      With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent5
            .TintAndShade = 0.599993896298105
            .PatternTintAndShade = 0
      End With
      Selection.Font.Bold = True
      ws.Range("O1").Select
    End If
  Next ws
End Sub

27/10/2016, 13h44
Jean-Philippe André

Ne mets pas des ws a toute les lignes pour me faire plaisir stp :ptdr:

Activesheet est un objet qui n'a pas besoin d'etre precede de ws par exemple =]

Voir 40 message(s) de cette discussion en une page