Réalisation d'un onglet RECAP

Bonjour à tous,

Je débutes actuellement dans la programmation VBA et j'aimerais avoir votre aide.

Je dois réaliser un fichier recap issue de plusieurs feuilles.

Je souhaites faire le recap quincaillerie des différents onglets (sauf LISTE) (TABLEAU T4: Y26)

La cerise sur le gâteau est d'additionner les quantités des éléments communs et de supprimer les lignes possédant une quantité 0 (Solution possible faire un tableau croisé dynamique de ma feuille recap)

J'ai trouvé un programme sur le forum par contre il copie la cellule c'est a dire avec les formules et je souhaiterai copier les valeurs seulement.

Si mes explications manques de précisions n’hésitez pas à me demander (Je suis un peu dans mon monde)

Merci d'avance de votre aide

Stéphane

22e-0xx-charpente.xlsm (108.59 Ko)

Bonjour Stphane4933 le forum

ton fichier en retour

tu cliques sur le bouton traiter et tu me redis

a+

Papou

15stphane4933-v1.xlsm (115.63 Ko)

Bonjour Stphane4933 le forum

ton fichier en retour

tu cliques sur le bouton traiter et tu me redis

la version V2 car je n'avais pas contrôlé mais avec ta colonne Quantité qui possède des tirets - !!!!

bref voilà

a+

Papou

26stphane4933-v2.xlsm (115.84 Ko)

Ok merci je regarde ça immédiatem ent

Salut papou un grand Merci c'est génial

Par contre pour ma curiosité pourrais tu m'expliquer un peu le programme.

le transfert correspond à la sélection des onglets, si je souhaites rajouter des onglets je dois mettre call copie et pour exclu des onglets case IS

Copie est un collage spéciale --> ok je dois encore travailler ça mais j'ai compris

Pour le traiter (Ma cerise ^^), pourrais tu me donner des explications, il y a des choses inconnu pour moi. Merci de ton retour

En tout cas, un grand merci j'espère pouvoir me redonner l'appareil un jour

Re Stphane4933 le forum

oui pour la feuille ajoutée tu peux rajouter avant le "end select"

Case Is = "Ta nouvelle Feuille"
            Call copie

C'est parce que j'ai repris un bout de ton code, mais si tu veux sans rien rajouter je te change le code ????

et dans ce cas tu pourras rajouter autant de feuilles même structure que les supports?? je ne sais plus et cela sera automatique

c'est toi qui me dit??

Pour le traiter, là c'est une macro (ça t'avais compris) , mais en gros :

1) je fais d'abord une copie de toutes tes lignes de tous tes tableaux concernant les feuilles Support etc dans la feuille Index, mais cela pourrait aussi être ailleurs voir même pas du tout sur une feuille seulement en mémoire, mais c'est plus pratique pour vérifier le déroulement je fais la liste et ensuite j'en fais un tableau aa

2) je fais une liste sans doublon de tous les éléments qui ont une quantité différente de zéro, j'en fais un tableau bb qui possède 6 lignes et un nombre de colonnes qui correspond au nombre d'éléments trouvés dans la liste sans doublons.

3) je transpose mon tableau pour avoir maintenant un tableau du nombre de ligne trouvées dans la liste sans doublons et de 6 colonnes le tableau cc

4) je fais une boucle sur tous les éléments de mon tableau cc et je fais une boucle sur mon tableau aa celui de tous les éléments de ma liste crée en 1) tableau aa au début de ma macro "Traiter", je commence par mettre ma cellule de la colonne 6 à vide au cas ou!!

5) pour chaque élément correspondant je fais la somme de la cellule de mon tableau cc + la quantité de l'élément trouvé dans ma boucle demon tableau aa

6) je restitue et je mets en forme la tableau restitué

voilà voilà

a+

Papou

Merci pour tout, surtout au niveau des explications que je vais digérer.

Je vais regarder cela en détails merci encore c cool

Effectivement je vais devoir rajouter des feuilles, mais je ne veux pas trop abuser

MErci à bientot sur le forum

re bonjour Stphane4933

Je te fais cela cet après midi

Bon appetit

papou

Bonjour

je pense a un truc comme ca

et voir si papou aime bien

Option Explicit
Public I&, Nom$

Sub transfert()
Dim Fin&
    With Feuil2
        Application.ScreenUpdating = 0
        Fin = .Range("T" & Rows.Count).End(xlUp).Row
        .Range("T2:M" & Fin).ClearContents
        .Range("A8:K" & Rows.Count).Clear
    End With
    For I = 1 To Worksheets.Count
        Nom = Sheets(I).Name
        Select Case Sheets(I).Name
            Case Is = Feuil2.Name, Feuil3.Name, Feuil8.Name
            Case Else
                Call copie
        End Select
    Next
    Call traiter
End Sub

A+

Maurice

Re bonjour Stphane4933 le forum

ton fichier avec la nouvelle macro, maintenant tu peux ajouter autant de feuille que tu le veux format Support bien sur, elles seront prises en compte.

a+

papou

EDIT: bonjour Archer, non je ne voyais pas cela tout à fait comme cela, j'ai supprimé aussi la macro copie, car je suis passé par des tableaux.

j'avais voulu laisser à Stphane4933 un bout de sa macro pour qu'il ne soit pas trop perdu mais là j'ai tout viré.

25stphane4933-v3.xlsm (115.47 Ko)

Merci papou et aussi Archer

Je vais regarder cela attentivement

A bientôt

Re stphane4933 le forum

pas de souci si tu veux d'autre renseignements tu sais ou demander

a+

Papou

Bonjour

encore moi HI

Option Explicit
Public I&, Nom$
Dim Sh As Object

Sub transfert()
Dim Fin&, Fin1&
Set Sh = Feuil2
Application.ScreenUpdating = 0
  Sh.Range("A8:K" & Rows.Count).Clear
    For I = 1 To Worksheets.Count
        Nom = Sheets(I).Name
        Select Case Sheets(I).Name
            Case Is = Feuil2.Name, Feuil3.Name, Feuil8.Name
            Case Else
                Fin = Sh.Range("T" & Rows.Count).End(xlUp).Row + 1
                With Sheets(Nom)
                    Fin1 = .Range("T" & Rows.Count).End(xlUp).Row
                    .Range("T4:W" & Fin1).Copy
                    Sh.Range("T" & Fin).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                End With
        End Select
    Next
    Call Traiter
End Sub

Sub Traiter()
Dim d As Object, aa, bb, a&, y&, Fin&, cc
Sh.Select
Set d = CreateObject("Scripting.Dictionary")
    Fin = Range("T" & Rows.Count).End(xlUp).Row
    aa = Range("T2:W" & Fin)
y = 1
    ReDim bb(1 To 6, 1 To y)
    For I = 1 To UBound(aa)
        If IsNumeric(aa(I, 4)) And aa(I, 4) > 0 And Not d.exists(aa(I, 3)) Then
            d.Add aa(I, 3), aa(I, 3)
            ReDim Preserve bb(1 To 6, 1 To y)
            bb(1, y) = aa(I, 1): bb(2, y) = aa(I, 2)
            bb(3, y) = aa(I, 3): bb(6, y) = aa(I, 4)
            y = y + 1
        End If
    Next I
cc = Application.Transpose(bb)
    For I = 1 To UBound(cc)
        cc(I, 6) = 0
        For a = 1 To UBound(aa)
            If aa(a, 3) = cc(I, 3) Then
                If IsNumeric(aa(a, 4)) Then
                    cc(I, 6) = cc(I, 6) + aa(a, 4)
                End If
            End If
        Next a
    Next I

Fin = Range("T" & Rows.Count).End(xlUp).Row
    Range("T2:W" & Fin).Clear
    Range("A8").Resize(UBound(cc), UBound(cc, 2)) = cc
    Range("A8").CurrentRegion.Borders.LineStyle = 1
Application.Goto [A1], True
End Sub

A+

Maurice

Rechercher des sujets similaires à "realisation onglet recap"