Consolidation nombre d'onglets variable par vba

Version imprimable

Bonjour le Forum

Mon probleme :
Dans un classeur excel 2007, j'ai un nombre variable de feuilles.
Je souhaite faire un code vba me permettant de consolider les feuilles choisies par une listbox (multiselect) sachant que les cellules sont toujours les mêmes.

Je bloque sur le code suivant qui me renvoie toujours des erreurs de type 9 ou autres.

pouvez vous m'aider?

Mon code :
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 Private Sub LBChoix_Change() Dim MaListe As String, i As Byte, sh As Worksheet, n As Byte MaListe = "" With Me.LBChoix For i = 0 To .ListCount - 1 If .Selected(i) Then MaListe = MaListe & fmChoixFeuille.LBChoix.List(i) & "!R8C22:R16C42" & "," End If Next i End With End Sub Private Sub CmdValid_Click() Sheets("Saisie (2)").Range("U8").Consolidate Sources:=MaListe, Function:=xlSum, TopRow:=True, LeftColumn _ :=True, CreateLinks:=False End Sub
Bien cordialement

consolidation nombre d'onglets

Bonjour,

Il aurait été bon de préciser sur quelle ligne se produit l'erreur.

Faute de pouvoir faire un essai (pas de fichier joint) cela ne convient-il pas ?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 Private Sub LBChoix_Change() Dim MaListe As String, i As Byte, sh As Worksheet, n As Byte MaListe = "" With Me.LBChoix For i = 0 To .ListCount - 1 If .Selected(i) Then MaListe = MaListe & .List(i) & "!R8C22:R16C42" & "," End If Next i End With End Sub
Par ailleurs :
- à la dernière sélection la "," ne sera-t-elle pas de trop ?
- je me demande si "with Me.LBChoix" n'est pas superflu dans la mesure où "private sub LBchoix_change" indique clairement où se situe l'action.

Cordialement,

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
 
Dim MaListe As String
 
Private Sub LBChoix_Change()
Dim  i As Byte, sh As Worksheet, n As Byte
MaListe = ""
With Me.LBChoix
 
        For i = 0 To .ListCount - 1
 
            If .Selected(i) Then
            MaListe = MaListe & fmChoixFeuille.LBChoix.List(i) & "!R8C22:R16C42" & ","
            End If
 
        Next i
 
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 
Sheets("Saisie (2)").Range("U8").Consolidate Sources:=MaListe, Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
 
End Sub

Bien cordialement[/QUOTE]

Bonjour lps02.

Pour commencer, tu dois sortir la déclaration Dim MaListe As String de la procédure et la mettre en tête du module, afin qu'elle soit visible dans les autres procédures du module.

Cordialement

Docmarti

bonjour,

Code:

MaListe = MaListe & fmChoixFeuille.LBChoix.List(i) & "!R8C22:R16C42" & ","

il y a toujours une virgule en trop!
Code:

1 2 Next i MaListe =left(MaListe ,len(MaListe )-1)
ou
Code:

1 2 3 4 5 If MaListe = "" Then MaListe = fmChoixFeuille.LBChoix.List(I) & "!R8C22:R16C42" Else MaListe = MaListe & "," & fmChoixFeuille.LBChoix.List(I) & "!R8C22:R16C42" End If

15/01/2014, 10h40
nibledispo

consolidation nombre d'onglets

Bonjour Robert,

Je vois que tu confirmes un de mes doutes.

Faute d'avoir un fichier pour essai sans lequel je suis incapable d'affirmer quoi que ce soit, peux-tu me dire si mon autre remarque est juste ou pas ?

Cordialement,
15/01/2014, 10h46
Invité

bonjour,nibledispo

"with Me.LBChoix" n'est pas une erreur tu propose

Code:

with LBChoix

qui marche également. j'aime mieux une déclinaison total qui permet de mieux définir de quoi on parle. le deux sont bon!
15/01/2014, 20h07
lps02
Bonjour à vous et merci pour vos réponses aussi rapide.

Hélas toujours probleme.
Renvoi d'une erreur 1004 reference de consolidation non valide à la ligne :
Code:

1 2 Sheets("Saisie (2)").Range("U8").Consolidate Sources:=MaListe, Function:=xlSum, TopRow:=True, LeftColumn _ :=True, CreateLinks:=False
Je recherche une solution vers un tableau pour la source type MonTableau () que je mettrai en reference.
Ce tableau serait rempli par ma listbox à partir des onglets choisis auquels j'ajouterai les référence de cellules.

Possible??
15/01/2014, 20h12
nibledispo

consolidation nombre d'onglets

Bonsoir,

Si tu veux espérer une réponse il faudrait peut-être nous joindre le code complet plutôt que des brides de code.

Cordialement

Bonsoir nibledispo

Merci de ton aide.

Ci joint mon code complet qui est lié au bouton "valider" de mon userform.

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
Dim MaListe As String
Private Sub UserForm_Initialize()
 
Dim s As Object
 
  For Each s In ActiveWorkbook.Sheets
  If s.Name <> "Parametres" And s.Name <> "Page" Then
    Me.LBChoix.AddItem s.Name
    End If
  Next s
  Me.LBChoix.ListIndex = -1
 
End Sub
 
 
 
 
Private Sub LBChoix_Change()
Dim i As Byte, sh As Worksheet, n As Byte
MaListe = ""
With Me.LBChoix
 
        For i = 0 To .ListCount - 1
 
            If .Selected(i) Then
            MaListe = MaListe & fmChoixFeuille.LBChoix.List(i) & "!R8C22:R16C42" & ","
            End If
 
        Next i
  MaListe = Left(MaListe, Len(MaListe) - 1)
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 
Sheets("Saisie (2)").Range("U8").Consolidate Sources:=MaListe, Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
 
End Sub
Private Sub CmdQuit_Click()
Unload Me
 
End Sub

Suite à mon précédent message, j'ai tenté de faire la même chose par tableau interposé. Via le code suivant :

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
Dim MaListe() As Variant
Private Sub UserForm_Initialize()
 
Dim s As Object
 
  For Each s In ActiveWorkbook.Sheets
  If s.Name <> "Parametres" And s.Name <> "Page" Then
    Me.LBChoix.AddItem s.Name
    End If
  Next s
  Me.LBChoix.ListIndex = -1
 
End Sub
 
 
 
 
Private Sub LBChoix_Change()
Dim i As Byte, sh As Worksheet, n As Byte
ReDim MaListe(1 To Me.LBChoix.ListCount - 1)
With Me.LBChoix
 
 
 
            For i = 1 To .ListCount - 1
            If .Selected(i) Then
            MaListe(i) = fmChoixFeuille.LBChoix.List(i) & "!R8C22:R16C42"
            End If
 
        Next i
 
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 
Sheets("Saisie (2)").Range("U8").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
 
End Sub
Private Sub CmdQuit_Click()
Unload Me
 
End Sub

Ce code me renvoie l'erreur suivante :Erreur 1004 la méthode Consolidate de la classe range a échouée.
à la ligne

Code:

1
2
Sheets("Saisie (2)").Range("U8").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False

N'est ce pas parce qu'il y a des lignes vides dans mon tableau (du au fait que les onglets de ma liste n'ont pas été selectionnées?

Merci de votre aide précieuse

Cordialement

lps02

15/01/2014, 21h26
nibledispo

consolidation nombre d'onglets

Bonsoir,

Il semble que tu n'as pas supprimer la "," à la fin de "maliste" comme je le soulignais plus haut et avec la ligne de code proposé par Rdurupt.
Commence par regarder si la "," est là et si oui supprime la.

Cordialement,

Bonjour lps02; nibledispo; rdurupt

@lps02
J'ai repris ton code en m'assurant que MaListe ne contienne pas d'éléments vides. Et l'erreur ne s'est pas manifesté.

Cordialement

Docmarti

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
Dim MaListe() As Variant
 
 
Private Sub UserForm_Initialize()
 
Dim s As Object
 
  For Each s In ActiveWorkbook.Sheets
  If s.Name <> "Parametres" And s.Name <> "Page" Then
    Me.LBChoix.AddItem s.Name
    End If
  Next s
  Me.LBChoix.ListIndex = -1
 
End Sub
 
 
 
 
Private Sub LBChoix_Change()
Dim i As Byte, sh As Worksheet, n As Byte
ReDim MaListe(0)
With Me.LBChoix
 
 
 
            For i = 0 To .ListCount - 1
            If .Selected(i) Then
 
            MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C22:R16C42"
            ReDim Preserve MaListe(UBound(MaListe) + 1)
            End If
 
        Next i
 
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 ReDim Preserve MaListe(UBound(MaListe) - 1)
Sheets("Saisie (2)").Range("U10").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
 
End Sub
Private Sub CmdQuit_Click()
Unload Me
 
End Sub

Docmarti,

Merci de ton aide. j'ai juste modifié le code pour la zone à consolider. Il faut garder la même zone que les onglets à consolider pour une consolidation par legne identiques. sinon tout se fait sur la même ligne.

Mon code :

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
Dim MaListe() As Variant
Private Sub UserForm_Initialize()
 
Dim s As Object
 
  For Each s In ActiveWorkbook.Sheets
  If s.Name <> "Parametres" And s.Name <> "Page" Then
    Me.LBChoix.AddItem s.Name
    End If
  Next s
  Me.LBChoix.ListIndex = -1
 
End Sub
 
 
 
 
Private Sub LBChoix_Change()
Dim i As Byte, sh As Worksheet, n As Byte
ReDim MaListe(0)
With Me.LBChoix
 
 
 
            For i = 0 To .ListCount - 1
            If .Selected(i) Then
 
            MaListe(UBound(MaListe)) = fmChoixFeuille.LBChoix.List(i) & "!R8C21:R16C42"
            ReDim Preserve MaListe(UBound(MaListe) + 1)
            End If
 
        Next i
 
  End With
 
End Sub
 
Private Sub CmdValid_Click()
 
 ReDim Preserve MaListe(UBound(MaListe) - 1)
Sheets("Saisie (2)").Range("U8:AP16").Consolidate Sources:=MaListe(), Function:=xlSum, TopRow:=True, LeftColumn _
            :=True, CreateLinks:=False
 
End Sub
Private Sub CmdQuit_Click()
Unload Me
 
End Sub

Bien cordialement et merci encore Docmarti.

lps02

16/01/2014, 00h32
Docmarti

Merci de l'info lps02.

C'est une fonction que je ne connaissais pas.

J'ai trouvé une excellente description de la marche à suivre

http://excel.developpez.com/faq/?page=Feuille#Consolider

Et un exemple très clair

http://www.excel-easy.com/examples/consolidate.html

Amicalement

Docmarti