Tableau 3D pour ventilation resultat en fonction du nom de feuille

Bonjour à tous,

Je viens vers vous car je suis un peu perdu face à mon souci, en effet dans le meme classeur sur une premiere feuille j ai la liste de differentes ville en colonne 1,

les colonnes 2 et 3 sont des chiffres.

je souhaite utiliser car inconnu par moi pour l'instant (je ne connais que les tableaux 2D), un tableau 3D qui pourrait ventiler les colonnes 2 et 3 sur les feuilles qui ont le meme nom que les lignes de la colonnes 1.

exprimé plus simplement, chaque fois que le tableau des noms de feuilles et egal au tableau général, je rempli un tableau 3D avec en premier le nom de la feuille, puis les deux colonnes de chiffres

comme vous le constaterez dans le fichier que je vais laisser comme exemple, tout se passe bien jusqu"à ce que je sois sur la feuille d'une ville, ensuite le souci arrive, excel ne met pas le tableau de colonnes de chiffres sur cette derniere, le vba passe sur ma ligne et rien se passe....

Pourriez vous m'éclairer?

merci d'avance

Bonne soirée

Jean-Noel

Hello,

Plutôt comme ceci :

Sub New_Methode()

Dim clas(), tot()

clas = Array("sisteron", "gap", "laragne", "veynes")
perf = Range("a2:c29")

Feuil1.Select

For c = 1 To UBound(clas)
    i = 1
    For p = 1 To UBound(perf)
        If clas(c) = perf(p, 1) Then
            ReDim Preserve tot(2, i)
            tot(1, i) = perf(p, 2)
            tot(2, i) = perf(p, 3)
            i = i + 1
        End If
    Next p
    Sheets(clas(c)).Activate
    Range("B1").Resize(UBound(tot, 2), UBound(tot, 1)) = Application.Transpose(tot)
    Erase tot
Next c

End Sub

R@g

Bonsoir,

J'ai peur de ne pas avoir bien compris mais je laisse ça là au cas où si jamais et pour ne pas perdre le travail ..

Sub JN()
Dim DER$, i%
Dim NOM As Variant
Set DICO = CreateObject("Scripting.Dictionary")
DER = Worksheets("MAIN").Cells(Cells.Rows.Count, 1).End(xlUp).Row
For Each c In Worksheets("MAIN").Range("A2:A" & DER)
    If Not DICO.Exists(c.Value) Then DICO.Add c.Value, c.Value
Next c
NOM = DICO.Items
For i = LBound(NOM) To UBound(NOM)
        Worksheets("MAIN").Range("A1:C" & DER).AutoFilter Field:=1, Criteria1:=NOM(i)
        Worksheets("MAIN").Range("A2:C" & DER).Copy
        Worksheets(NOM(i)).Select
        DER_A = ActiveSheet.Cells(Cells.Rows.Count, 1).End(xlUp).Row
        ActiveSheet.Cells(DER_A, 1).PasteSpecial Paste:=xlPasteValues
        Worksheets("MAIN").ShowAllData
Next i
End Sub

Bonne soirée.

Tout d'abord un grand merci pour votre aide HYPER précieuse, la deuxieme solution est bien la bonne pour moi, ca marche parfaitement.

encore merci et bravo!!!

bonne journée

Jean noel