Formule de soumission (Quotation)

Bonjour à tous,

J'aimerais faire un fichier Excel pour m'aider à faire mes proposition à mes clients . . .

Je crois que mon idée est simple, mais je trouve pas la solution . . . ?????

A partir des onglets (SECT-A, SECT-B, SECT-C) je choisi la quantité et les items désiré . . . et j'aimerais qu'ils s'affiche dans l'onglet SOUM-clients (quantité et description) . . . ensuite le prix total devra s'afficher dans l'onglet Prix :

Peut-être simple . . . mais ça me donne des mal de têtes . . .

Merci de m'aider . . .

Bonjour et bienvenue sur le forum motton,

Voici une solution :

Sub consolide()
Dim i As Byte    ', total As Single
Dim j As Long, derlign As Long, tailleTablo As Long, cpt As Long, derlign2 As Long
Dim tablo

    If Sheets(1).Name <> "SOUM-Clients" Then
        MsgBox "La première feuille doit s'appeler ""SOUM-Clients""", _
               vbExclamation, "Nom de feuille incorrect"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    If Sheets(1).[A65536].End(xlUp).Row >= 13 Then Sheets(1).Range("A13:C" & Sheets(1).[A65536].End(xlUp).Row).ClearContents
    For i = 2 To Sheets.Count
        If Sheets(i).Name Like "SECT-*" Then
            With Sheets(i)
                derlign = .[b65536].End(xlUp).Row
                tailleTablo = Application.WorksheetFunction.Count(.Range("A5:A" & derlign))
                ReDim tablo(1 To tailleTablo, 1 To 3)
                For j = 5 To derlign
                    If .Cells(j, 1) <> "" Then
                        cpt = cpt + 1
                        tablo(cpt, 1) = .Cells(j, 1)
                        tablo(cpt, 2) = .Cells(j, 2)
                        tablo(cpt, 3) = .Cells(j, 3)
                        'total = total + .Cells(j, 1) * .Cells(j, 3)
                    End If
                Next j
                cpt = 0
                With Sheets(1)
                    With .Range("A65536").End(xlUp)
                        derlign2 = IIf(.Row + 1 < 13, 13, .Row + 1)
                    End With
                    .Range("A" & derlign2 & ":C" & derlign2 + tailleTablo - 1) = tablo
                End With
            End With
        End If
    Next i

End Sub

Fichier :

Remarques :

• La première feuille doit s'appeler "SOUM-Clients"
• Les noms des onglets où tu choisis la quantité et les items désirés doivent être du type "SECT-*"

Par contre je n'ai pas vu d'onglet "Prix". J'ai donc mis le prix total dans la case adéquate de la 1ère feuille.

Merci Beaucoup . . .

J'ai passé plusieurs soirées avant de demander de l'aide . . .

Merci, c'est très apprécié . . .

-- 06 Juil 2010, 09:22 --

Après avoir fait quelques essais . . . j'ai découvert les choses suivante . . .

Quand je change ou annule des quantités dans les onglets ``SECT`` le prix ne change pas et il m'apparait un message d'erreur . . .

Puis-je avoir encore un peu d'aide . . . SVP . . .

Bonjour mottom,

Peux-tu me dire exactement la manipulation que tu fais pour arriver à ce message d'erreur ? Et quel message d'erreur obtiens-tu ?

Quand tu dis que le prix ne change pas, tu parles du prix total dans l'onglet "SOUM-Clients" ?

Voici le message d'erreur que je recois . . .

L'erreur ce produit quand je change ou efface une quantitée dans les onglets ``SECT`` et que j'appuit a nouveau sur le bouton Consolider.

Je crois que le prix (onglet SOUM-CLIENT) ne change pas ou ça dépend des changements . . .

Et si tu cliques sur "Débogage" peux-tu me dire quelle ligne est surlignée en jaune ?

Voici la ligne en jaune . . .

ReDim tablo(1 To tailleTablo, 1 To 3)

J'avais oublié la possibilité que l'on pouvait ne rien commander !

Voici le code corrigé

Sub consolide()
Dim i As Byte, total As Single
Dim j As Long, derlign As Long, tailleTablo As Long, cpt As Long, derlign2 As Long
Dim tablo

    If Sheets(1).Name <> "SOUM-Clients" Then
        MsgBox "La première feuille doit s'appeler ""SOUM-Clients""", _
               vbExclamation, "Nom de feuille incorrect"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    If Sheets(1).[A65536].End(xlUp).Row >= 13 Then Sheets(1).Range("A13:C" & Sheets(1).[A65536].End(xlUp).Row).ClearContents
    For i = 2 To Sheets.Count
        If Sheets(i).Name Like "SECT-*" Then
            With Sheets(i)
                derlign = .[b65536].End(xlUp).Row
                tailleTablo = Application.WorksheetFunction.Count(.Range("A5:A" & derlign))
                If tailleTablo > 0 Then
                    ReDim tablo(1 To tailleTablo, 1 To 3)
                    For j = 5 To derlign
                        If .Cells(j, 1) <> "" Then
                            cpt = cpt + 1
                            tablo(cpt, 1) = .Cells(j, 1)
                            tablo(cpt, 2) = .Cells(j, 2)
                            'tablo(cpt, 3) = .Cells(j, 3)
                            total = total + .Cells(j, 1) * .Cells(j, 3)
                        End If
                    Next j
                    cpt = 0
                    With Sheets(1)
                        With .Range("A65536").End(xlUp)
                            derlign2 = IIf(.Row + 1 < 13, 13, .Row + 1)
                        End With
                        .Range("A" & derlign2 & ":C" & derlign2 + tailleTablo - 1) = tablo
                    End With
                End If
            End With
        End If
    Next i
    Sheets(1).[e7] = total

End Sub

Merci !