Discussion :

[Praline89]

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.

[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.

[halaster08]

Bonjour,

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 ?

[Praline89]

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 :

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

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
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.

[halaster08]

Essaye ceci:

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
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é

[MarcelG]

Salut Praline,

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

Code :

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

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 :

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

[Praline89]

Halaster08,

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

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 !

[MarcelG]

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 :

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

[Philippe Tulliez]

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

[halaster08]

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

Code :

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

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 :

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

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.

[Philippe Tulliez]

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 :

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

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

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

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

Code :

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

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

Exemple de son utilisation (comme un Function)

Code :

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

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

[Praline89]

Coucou à tous,

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

Alors, dans l'ordre :

@MarcelG :

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 :

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

Code :

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

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 :

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

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 :

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