Reccupération de quantités sur plusieurs feuilles

Bonjour,

Voici mon premier post sur ce forum que j'utilise depuis longtemps pour trouver les solutions à mes problèmes liés à Excel.

Je vous expose mon problême :

J'ai un fichier avec une dizaine de feuilles, toutes au même format

Article | Désignation article | Qté

Sur une même feuille, j'ai parfois deux (ou plus) lignes pour le même article, avec une quantité différente associée à chaque ligne.

Les articles sont généralement présents sur plusieurs feuilles.

Je souhaiterais avoir sur une nouvelle feuille : un listing de tous mes articles uniques, leur désignation et la somme de toutes leur quantité (somme des différentes feuilles).

Voila la base du problême, Je vous joint un exemple de fichier.

N'hésitez pas si vous avez besoin de plus d'informations de ma part.

Merci d'avance

Bonjour,

Le plus simple :

Tu copies toutes tes feuilles les unes a la suite des autres dans un nouvel onglet

tu ajoutes une colonne avec somme.si(articles;a2;Qté néces)

puis tu supprimes les doublons

Crdmt

Bonjour Tr05,

Bonjour Djidji,

une façon de faire en VBA et mon petit bouton rouge habituel...

La macro lit chaque feuille et crée un tableau qu'elle colle trié en Feuil1 après avoir pris soin d'effacer le contenu de toutes.

Son office terminé, le bouton rouge disparaît!

Private Sub cmdGO_Click()
'
Dim tTab, tNewTab()
'
Application.ScreenUpdating = False
'
ReDim Preserve tNewTab(3, iIdx + 1)
'
For x = 1 To Sheets.Count
    With Sheets(x)
        iRow = .Range("A" & Rows.Count).End(xlUp).Row
        tTab = .Range("A3:C" & iRow)
        For y = 1 To UBound(tTab, 1)
            iFlag = 0
            For Z = 0 To UBound(tNewTab, 2) - 1
                If tTab(y, 1) = tNewTab(0, Z) Then
                    tNewTab(2, Z) = tNewTab(2, Z) + tTab(y, 3)
                    iFlag = 1
                End If
            Next
            If iFlag = 0 Then
                iIdx = iIdx + 1
                ReDim Preserve tNewTab(3, iIdx)
                For w = 1 To 3
                    tNewTab(w - 1, iIdx - 1) = tTab(y, w)
                Next
            End If
        Next
        sCol = IIf(x = 1, "A3:C", "A1:C")
        .Range(sCol & iRow).ClearContents
    End With
Next
'
Range("A3").Resize(iIdx, 3) = WorksheetFunction.Transpose(tNewTab)
Range("A3").Resize(iIdx, 3).Sort key1:=Range("A3"), order1:=xlAscending
'
Me.cmdGO.Visible = False
Application.ScreenUpdating = True
'
End Sub

Bon travail!

A+