Macro VBA & création synthèse de plusieurs feuilles Excel

Version imprimable

27/02/2019, 09h49
Praline89

Macro VBA & création synthèse de plusieurs feuilles Excel

Bonjour à tous !

Je suis toute nouvelle sur ce forum (j'ai même fait une petite présentation dans la partie appropriée) et dans le monde du langage VBA également.

Alors, je vous expose ma problématique : j'ai un classeur Excel constitué de plusieurs feuilles. Toutes ces feuilles ont la même trame, il s'agit d'une analyse de risques par domaines, chaque feuille concerne un domaine particulier. Je souhaite faire une feuille de synthèse (appelée "Synthèse" forcément) qui reprendrait les lignes "prioritaires".
J'ai donc écrit un petit bout de macro qui fonctionne jusqu'à une certain point. En fait, c'est le processus du "Copier-Coller" les lignes intéressantes que je ne maîtrise pas. Je ne récupère que la toute dernière ligne souhaitée (au lieu d'avoir toutes les lignes les unes en dessous des autres) et j'ai l'impression que je copie-colle à chaque fois sur la même ligne. J'ai pourtant essayer de déclarer une variable définie comme la première ligne vide sur laquelle écrire.
J'ai vérifié que ma macro allait bien lire toutes les lignes de toutes les feuilles et ça semble bien fonctionner. Donc c'est vraiment dans cette dernière partie que j'ai une erreur.

Auriez-vous un petit conseil à me donner s'il-vous-plaît ? Si besoin, je peux vous fournir les approximativement 5 lignes de code qui composent ma macro ^^

Merci d'avance.

Praline.
27/02/2019, 09h59
MarcelG

Bonjour Praline89

(J'adore tout ce qui est praliné: chocolat, Paris-Brest...)

Donc soit doublement la bienvenue sur ce forum.

Le plus efficace serait bien entendu que tu reportes l'intégralité du code en précisant le(s) point(s) d'achoppement.
27/02/2019, 10h29
halaster08

Bonjour,

Citation:

Envoyé par Praline89

Je ne récupère que la toute dernière ligne souhaitée (au lieu d'avoir toutes les lignes les unes en dessous des autres) et j'ai l'impression que je copie-colle à chaque fois sur la même ligne. J'ai pourtant essayer de déclarer une variable définie comme la première ligne vide sur laquelle écrire.

Si tu copie colle tout sur la même ligne c'est probablement pour ça que tu n'as que la dernière.
Déclarer ta variable c'est bien, mais as-tu penser à la recalculer après chaque copier-coller ?

Bonjour MarcelG,

Merci beaucoup pour ton accueil ! Et c'est vrai, c'est vraiment trop bon le praliné.

Bref, revenons à nos moutons. Tu trouveras ci-dessous le code "Synthèse"

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
Sub Synthèse()
 
Dim i As Integer
Dim j As Integer
Dim der_ligne As Integer
Dim last_line As Integer
 
last_line = Worksheets("Synthèse").Range("A65536").End(xlUp).Row + 1
 
For i = 2 To Worksheets.Count
 
der_ligne = Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
 
    For j = 3 To der_ligne
 
        If Worksheets(i).Cells(j, 23).Value = 1 Then
            Worksheets(i).Cells(j, 1).EntireRow.Copy
            Worksheets("Synthèse").Cells(last_line, 1).EntireRow.Select
            Worksheets("Synthèse").Paste
        End If
 
    Next j
 
Next i
 
End Sub

A première vue, ce sont les deux dernières lignes de ma boucle If qui me posent problème. En effet, j'ai vérifié le fait que ma macro allait bien la condition Worksheets(i).Cells(j, 23).Value = 1 sur toutes les feuilles grâce à la macro suivante :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Test()
 
Dim i As Integer
Dim j As Integer
Dim der_ligne As Integer
 
For i = 2 To Worksheets.Count
 
der_ligne = Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
 
    For j = 3 To der_ligne
 
        If Worksheets(i).Cells(j, 23).Value = 1 Then
            Worksheets("Synthèse").Cells(j, i) = 1
            Else: Worksheets("Synthèse").Cells(j, i) = 0
        End If
 
    Next j
 
Next i
 
End Sub

Celle-ci fonctionne correctement.

Voilà ! Je te remercie d'avance de ton aide.

Praline.

Essaye ceci:

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
Sub Synthèse()
 
Dim i As Integer
Dim j As Integer
Dim der_ligne As Integer
Dim last_line As Integer
 
last_line = Worksheets("Synthèse").Range("A65536").End(xlUp).Row + 1
 
For i = 2 To Worksheets.Count
 
der_ligne = Worksheets(i).Cells.SpecialCells(xlCellTypeLastCell).Row
 
    For j = 3 To der_ligne
 
        If Worksheets(i).Cells(j, 23).Value = 1 Then
            Worksheets(i).Cells(j, 1).EntireRow.Copy
            Worksheets("Synthèse").Cells(last_line, 1).EntireRow.Select
            Worksheets("Synthèse").Paste
            last_line=last_line +1
        End If
 
    Next j
 
Next i
 
End Sub

Vu ta condition tu pourrais aller plus (sans boucle sur les lignes) en passant par un filtre avancé

Salut Praline,

J'ai rapidement regardé ton code.
Attention de bien redéfinir la variable last_line après copie.

Code:

1
2
 
last_line = last_line +1

Autre remarque, s'il te plaît, supprime ces f...Select.
La méthode Copy admet comme argument Destination

Enfin, afin de rendre un code plus lisible, ne pas hésiter à utiliser le bloc With

Essaie donc d'appliquer le code ci-dessous proposé.

Code non testé.

Je reviendrai sur le Forum vers 13 h 45. D'ici là, n'hésite pas à revenir.

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
Option Explicit
 
Sub Synthèse()
 
Dim i As Integer
Dim j As Integer
Dim der_ligne As Integer
Dim last_line As Integer
 
last_line = Worksheets("Synthèse").Range("A65536").End(xlUp).Row + 1
 
For i = 2 To Worksheets.Count
 
        With Worksheets(i)
 
                If .Name <> "Synthèse" Then
 
                        der_ligne = .Cells.SpecialCells(xlCellTypeLastCell).Row
 
                        For j = 3 To der_ligne
 
                                If .Cells(j, 23).Value = 1 Then
                                        .Cells(j, 1).EntireRow.Copy Destination:=Worksheets("Synthèse").Cells(last_line, 1)
                                        last_line = last_line + 1
                                End If
 
                        Next j
 
                End If
 
        End With
 
Next i
 
End Sub

27/02/2019, 11h08
Praline89

Halaster08,

Je te remercie pour ta première remarque, c’est exactement ce que j’ai fait.

Citation:

Envoyé par halaster08

Essaye ceci

Du coup, ça fonctionne beaucoup mieux ! Je me sens un peu bête, c’était tellement évident.

MarcelG, merci pour tes remarques également, je vais essayer ce que tu me proposes pour simplifier et je reviens te donner le résultat !

[EDIT] : MarcelG, j’ai testé le code que tu m’as proposé, ça fonctionne parfaitement. Et c’est vrai que c’est beaucoup plus simple comme ça. Je ne connaissais pas le .Name, merci.

Encore merci à tous les deux pour vos conseils !

Praline,

Autre chose.
Eviter les copies de lignes entières car des erreurs peuvent survenir.
Mieux vaut, dans ce cas, définir la dernière colonne informée et, partant, l'objet Range à recopier.

Ainsi

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
Option Explicit
 
Sub Synthèse()
 
Dim i As Integer
Dim j As Integer
Dim der_ligne As Integer, der_col As Byte
Dim last_line As Integer
 
last_line = Worksheets("Synthèse").Range("A65536").End(xlUp).Row + 1
 
For i = 2 To Worksheets.Count
 
        With Worksheets(i)
 
                If .Name <> "Synthèse" Then
 
                        der_ligne = .Cells.SpecialCells(xlCellTypeLastCell).Row
 
                        For j = 3 To der_ligne
 
                                If .Cells(j, 23).Value = 1 Then
                                        der_col = .Cells(1, .Columns.Count).End(xlToLeft).Column
                                        .Range(.Cells(j, 1), .Cells(j, dercol)).Copy Destination:=Worksheets("Synthèse").Cells(last_line, 1)
                                        last_line = last_line + 1
                                End If
 
                        Next j
 
                End If
 
        End With
 
Next i
 
End Sub

27/02/2019, 13h50
Philippe Tulliez

Bonjour,
Comme l'a très justement faire remarquer halaster08 à la fin de sa réponse (Post ), le filtre avancé d'excel (méthode AdvancedFilter de l'objet Range) permet de faire cela en moins de six lignes de code si les zones des données, critères et cibles sont nommées.

A lire sur le sujet Les filtres avancés ou élaborés dans Excel
27/02/2019, 13h53
halaster08

Quitte à écrire code propre, je te propose de modifié la manière dont tu détermine la dernière ligne:

Code:

last_line = Worksheets("Synthèse").Range("A65536").End(xlUp).Row + 1

Depuis longtemps (passage de xls à xlsx) Excel permet d'avoir plus 65536 lignes, donc si tu dépasse ce nombre de ligne ton code ne fonctionne plus.
Remplace le par:

Code:

last_line = Worksheets("Synthèse").Range("A" & rows.count).End(xlUp).Row + 1

Qui a l'avantage de fonctionner a coup sur peu importe la version d'Excel que tu utilise.

AdvancedFilter - Exportation des données suivant critères avec possibilité d'ajouter les lignes exportées

Bonjour,

Fonction "clé sur porte" avec la méthode AdvancedFilter qui permet d'exporter les données suivant critères avec l'option d'ajouter les données à la suite de celles déjà exportées

Pour comprendre cette méthode, la lecture de ce tutoriel Les filtres avancés ou élaborés dans Excel est indispensable

Code de la fonction nommée CopyDataByAdvancedFilter
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 Function CopyDataByAdvancedFilter(RngSource As Range, _ RngTarget As Range, _ RngCriteria As Range, _ Optional Append As Boolean) As Range ' Auteur : http://philippe.tulliez.be ' Exporte les données suivant les critères et renvoie un objet Range de la zone cible ' Arguments ' Rngsource ' Zone des données ' RngTarget ' Zone cible (là où les données doivent être exportées ' RngCriteria ' Zone des critères ' [Append] ' Si True ajoute les données à la suite des données de la zone RngTarget Dim rngTargetInitial As Range Set rngTargetInitial = RngTarget If Append Then ' * Recalcule la zone cible déjà remplie Set RngTarget = RngTarget.CurrentRegion ' ** Se positionne sur la ligne suivante With RngTarget Set RngTarget = .CurrentRegion.Offset(.Rows.Count).Resize(1) End With Else RngTarget.Worksheet.Cells.Clear ' Efface les lignes éventuelles déjà présentes End If RngSource.AdvancedFilter xlFilterCopy, RngCriteria, RngTarget ' Efface la ligne de titre exportée If Append Then RngTarget.Delete xlShiftUp ' Redéfini la zone cible Set CopyDataByAdvancedFilter = rngTargetInitial.CurrentRegion ' Fin de programme Set rngTargetInitial = Nothing End Function
Dans les exemples qui suivent les zones source, cible et critères sont nommées (Gestionnaire des noms)

Exemple de son utilisation (comme un Sub)

Exemple avec nouvelle copie (Efface les données précédentes)

Code:

CopyDataByAdvancedFilter Range("areaData"), Range("areaTarget"), Range("areaCriteria")

Exemple avec copie à la suite des données déjà présentes

Code:

CopyDataByAdvancedFilter Range("areaData"), Range("areaTarget"), Range("areaCriteria"), True

Exemple de son utilisation (comme un Function)

Code:

MsgBox CopyDataByAdvancedFilter(Range("areaData"), Range("areaTarget"), Range("areaCriteria"), True).Address

[EDIT]
Extrait de la liste des cellules nommées
areaCriteria =BD!$J$1:$J$2
areaData =BD!$A$1:$H$31
areaTarget =Cible!$A$1

27/02/2019, 15h54
Praline89

Coucou à tous,

Waaa !! Que d'indications et conseils. Franchement, vous êtes vraiment top !

Alors, dans l'ordre :

@MarcelG :

Citation:

Eviter les copies de lignes entières car des erreurs peuvent survenir.
Mieux vaut, dans ce cas, définir la dernière colonne informée et, partant, l'objet Range à recopier

C'est vrai, merci pour l'astuce, autant éviter au maximum les erreurs.

@halaster08 :

Citation:

Quitte à écrire code propre, je te propose de modifié la manière dont tu détermine la dernière ligne:

Code:

last_line = Worksheets("Synthèse").Range("A65536").End(xlUp).Row + 1

Depuis longtemps (passage de xls à xlsx) Excel permet d'avoir plus 65536 lignes, donc si tu dépasse ce nombre de ligne ton code ne fonctionne plus.
Remplace le par:

Code:

last_line = Worksheets("Synthèse").Range("A" & rows.count).End(xlUp).Row + 1

Qui a l'avantage de fonctionner a coup sur peu importe la version d'Excel que tu utilise.

D'accord. Je te remercie pour cette information. J'avoue, comme je suis vraiment débutante, j'ai glané ça et là le plus d'informations possible pour me permettre d'écrire cette macro et je ne me suis pas posé la question de savoir si Excel avait évoluer en terme de nombre de lignes... Maintenant, je sais :)

@Philippe Tulliez :

Citation:

Bonjour,
Comme l'a très justement faire remarquer halaster08 à la fin de sa réponse (Post #5), le filtre avancé d'excel (méthode AdvancedFilter de l'objet Range) permet de faire cela en moins de six lignes de code si les zones des données, critères et cibles sont nommées.

A lire sur le sujet Les filtres avancés ou élaborés dans Excel

Je vais me pencher là-dessus, il va me falloir un peu de temps pour comprendre tout ça. La méthode AdancedFilter m'est complètement inconnue...

En tout cas, merci à tous. Ce qui est sûr, c'est que grâce à vous, on ne peut que progresser :D