Modification d'un code

[gillesbe]

Bonsoir à toutes et`À Tous,

Une fois que l'on prend gout a la programation on a du mal a s'en defaire.
J'ai réussi a bidouiller un code et a l'adapter partiellement.
Il 'agit de reprendre des informations dans un onglet "conso" (même classeur) (tableau pre-défini): 3 colonnes; et d'ouvrir autant d'onglet que nécessaire pour consolider les informations selon un critere ( ici le compte de charges)
Chaque onglet pays, reprend deux informations qui s'aditionnent: Libelle et sOMME de population.

`Voilá, je voudrais augmenter dans chaque onglet de deux a cinq les informations reprisent dans l'onglet principal.
SI QUELQU'UN POUVAIT ME DIRE COMMENT FAIRE J'APPRECIERAIS

Cordialement

gilles





Sub Ventiler()
Dim dico, tablo, i&, Classe, Denom_classe_custo, aux As Range

Application.ScreenUpdating = False
'dico maître
Set dico = Nothing
Set dico = CreateObject("scripting.dictionary")

'lecture du tableau
With Sheets("Consolidação")
tablo = .Range("a2:c" & .Range("a" & Rows.Count).End(xlUp).Row).Value
End With

'remplissage dido de dico
For i = 1 To UBound(tablo)
If Not dico.exists(tablo(i, 1)) Then
dico.Add tablo(i, 1), CreateObject("scripting.dictionary")
End If
If Not dico(tablo(i, 1)).exists(tablo(i, 2)) Then
dico(tablo(i, 1)).Add tablo(i, 2), CreateObject("scripting.dictionary")
dico(tablo(i, 1))(tablo(i, 2)) = tablo(i, 3)
Else
dico(tablo(i, 1))(tablo(i, 2)) = dico(tablo(i, 1))(tablo(i, 2)) + tablo(i, 3)
End If
Next i

'affichage
For Each Classe In dico.keys
'Test si feuille correspondant au Classe existe ou non
On Error Resume Next
Set aux = Sheets(Classe).Range("a1")
If Err.Number > 0 Then
'créer une nouvelle feuille
Worksheets.Add after:=Worksheets("Consolidação")
With ActiveSheet
.Name = Classe
.Range("b3") = "Classe": .Range("c3") = Classe
.Range("b6") = "Denom.classe custo": .Range("c6") = "SOMME POPULATION"
.Cells.Interior.ColorIndex = 2
End With
End If
On Error GoTo 0

With Sheets(Classe)
.Activate
'effacement des précédents résultats
i = 0
Do Until Len(.Range("b7").Offset(i)) = 0
.Range("b7").Offset(i).Resize(, 2) = Empty
.Range("b7").Offset(i).Resize(, 2).Borders.LineStyle = xlLineStyleNone
i = i + 1
Loop

'écriture résultat
i = 0
For Each Denom_classe_custo In dico(Classe).keys
.Range("b7").Offset(i) = Denom_classe_custo
.Range("b7").Offset(i, 1) = dico(Classe)(Denom_classe_custo)
i = i + 1
Next Denom_classe_custo

'tri
.Range("b6").Resize(i + 1, 2).Sort key1:=Range("b6"), order1:=xlAscending, Header:=xlYes

'encadrement et format
.Range("b6").Resize(i + 1, 2).Borders.LineStyle = xlContinuous
.Columns("b:c").EntireColumn.AutoFit
.Range("c7").Resize(i).NumberFormat = "#,##0"
End With
Next Classe

Application.Goto Sheets("Consolidação").Range("a1"), True
MsgBox "A Integração Terminou."
Application.ScreenUpdating = True
End Sub