VBA trouver la plus petite valeur

Bonjour

J'ai 10 pages nommées "magasin 1", "magasin 2"... Jusqu'à magasin 10

Et j'ai une page "Resultat"

J'ai la même trame sur l'ensemble de mes pages

Je souhaiterais que dans ma page resultat trouver la plus petite valeur de l'ensemble des 10 magasins

Exemple : j'ai ma liste de produits en colonne A

Et j'ai mes prix en colonne B

Je voudrais que de B8 a B29 de ma feuille resultat trouver le prix le moins cher de mes pages magasin

(La trame est la même partout : le produit present en a8 est le meme sur toutes les pages magasins et sur la page resultat)

Attention : il se peut que des pages magasins ne soient pas remplis en B8 par exemple mais que d'autres si

Et je ne veux pas m'occuper des magasins sans valeur mais trouver le moins cher parmis les magasins complétés

Pour le moment je cherche le moins cher et par la suite je chercherais comment faire la moyenne des prix des 10 magasins en ne m'occupant également que des cellules remplies pour effectuer cette moyenne.

Je remercie d'avance toute personne pouvant m'aider

Cordialement

Bonjour,

Avec une fonction Perso. La cellule passée en argument est la même pour toutes les feuilles et la feuille "Résultat" est évitée :

Public Function PLUS_PETIT_PRIX(Cel As Range) As Double

    Dim Fe As Worksheet
    Dim PrixMini As Double

    Application.Volatile

    'initialise
    PrixMini = 1000000000

    For Each Fe In Worksheets 'parcour la collection de feuilles

        If Fe.Name <> "Résultat" Then 'évite la feuille "Résultat"

            If Fe.Range(Cel.Address).Value > 0 Then 'évite les valeurs = à 0
                If Fe.Range(Cel.Address).Value < PrixMini Then PrixMini = Fe.Range(Cel.Address).Value
            End If

         End If

    Next Fe

    PLUS_PETIT_PRIX = PrixMini

End Function

et dans une cellule de la feuille "Résultat" :

=PLUS_PETIT_PRIX(B8)

Bonjour,

Une autre proposition à étudier.

Cdlt.

Option Explicit

Private Sub Worksheet_Activate()
Dim ws As Worksheet
Dim arr(1 To 10)
Dim I As Byte, J As Byte
Dim modeCalc As XlCalculation

    With Application
        modeCalc = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> Me.Name Then
            If Application.Min(ws.ListObjects(1).ListColumns(2).DataBodyRange) = 0 Then
                MsgBox "La feuille " & ws.Name & " comporte une ou des valeurs à 0.", _
                       vbExclamation, "Valeurs à 0"
                Exit Sub
            End If
        End If
    Next ws

    For I = 1 To 22
        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> Me.Name Then
                J = J + 1
                arr(J) = ws.ListObjects(1).ListColumns(2).DataBodyRange.Cells(I)
                With Me.ListObjects(1)
                    .ListColumns(2).DataBodyRange.Cells(I) = Application.Min(arr)
                    .ListColumns(3).DataBodyRange.Cells(I) = Application.Average(arr)
                End With
            End If
        Next ws
        Erase arr()
        J = 0
    Next I

    Application.Calculation = modeCalc

    MsgBox "La mise à jour des prix a été effectuée.", _
           vbInformation, "Mise à jour des prix"

End Sub

Bonjour,

Tu penses donner de tes nouvelles un jour ?

Cdlt.

Bonjour,

@ Jean-Eric : oui le jour où un autre problème surviendra

Bonne journée,

Vbabeginner

Bonjour,

Oui désolé j'étais passé à autre chose depuis ce problème.

Cependant je confirme que la solution proposée est très très bien.

Merci pour votre aide

Cordialement

Inutile