Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"

Zonmé

XLDnaute Nouveau
Bonjour à tous,
j'ai récemment reçu de l'aide dans mon apprentissage du VBA via ces forums, et je m'en remets une nouvelle fois à vous!
Dans un tableau que j'ai créé, je voudrais via une macro ouvrir une fenêtre de sélection d'options proposée en fonction de la valeur d'une cellule du tableau.
Dans mon code ci-dessous, je voudrais suivant la valeur de la case C30 "Stock" avoir l'affichage d'une message box ou j'utilise la fonction SelectCase pour reporter le choix des options, avec:
- Si "Stock" (C30) = Yes, alors une msgbox s'ouvre avec 3 choix (via vbYesNoCancel):
Garder l'option 1 (bouton Oui de la msgbox) et reporter les valeurs des cases B76:I77; B79:I93 et la cellule C18 en feuille "Product List"
Garder l'option 2 (bouton Non de la msgbox) et reporter les valeurs des cases B76:I76; B78:I93 et la cellule C18 en feuille "Product List"
Garder l'option 3 (bouton Annuler de la msgbox) et reporter les valeurs des cases B76:I76; B79:I93 et la cellule C18 en feuille "Product List"
- Si "Stock" (C30) = No ou Vide, alors msgbox s'ouvre avec 2 choix (via vbYesNo):
Garder l'option 1 (bouton Oui de la msgbox) et reporter les valeurs des cases B77:I77; B79:I93 et la cellule C18 en feuille "Product List"
Garder l'option 2 (bouton Non de la msgbox) et reporter les valeurs des cases B78:I93 et la cellule C18 en feuille "Product List"
Je sis arriver à avoir les bonnes msgbox et report de valeur en les séparant en deux macro, mais je n'arrive pas à les combiner via un If Else Then, et me retrouve avec une message d'erreur "Erreur de Compilation: Else sans If" (image en PJ).
Voici le code actuel que j'ai rédigé:
VB:
Sub AjoutProd()
Dim Stock       As Integer
Dim Retour      As Integer
Dim Retour2     As Integer
Stock = ActiveSheet.Range(C30).Value
If Stock = Yes Then
        Retour = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                 "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "My Film - " & ActiveSheet.Range("E76").Value & "mm wide film in stock", vbYesNoCancel, "Please Select your film option")
        Select Case Retour
            Case 6        'Oui
                ActiveSheet.Range("B76:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 2        'Annuler
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
Else
        Retour2 = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                  "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  vbYesNo, "Please Select your film option")
        Select Case Retour2
            Case 6        'Oui
                ActiveSheet.Range("B77:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
End If
End Sub

Voilà, j'espère avoir été assez clair dans ma demande et si quelqu'un sait me le corriger ou me conseiller sur sa mise au point ce serait génial!
Je me tiens à votre disposition pour plus de détails avec grand plaisir!
 

Pièces jointes

  • Erreur Compilation.jpg
    Erreur Compilation.jpg
    12.8 KB · Affichages: 2
Solution
Je me suis permis de réécrire ta macro, j'en ai créé 2 pour éviter la répétition de code et alléger la macro. J'ai ajouté des constantes pour plus de lisibilité. Non testé puisque pas de fichier. Utilise et adapte si/comme tu veux.

VB:
Option Explicit
Sub AjoutProd()
    Const YES_OPTION = 6
    Const NO_OPTION = 7
    Const CANCEL_OPTION = 2
    
    Dim Stock As String
    Dim Retour As Integer
    Dim message As String
    
    Stock = ActiveSheet.range("C30").Value
    message = "What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
    "Option 1 - " & ActiveSheet.range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
    "Option 2 - " & ActiveSheet.range("E78").Value & "mm wide film" & Chr(13) & Chr(10)...

Zonmé

XLDnaute Nouveau
Re bonjour @Franc58 ,
je viens d'essayer de modifier en rajoutant les end select, et du coup j'ai désormais une erreur 400 (enPJ)!
VB:
Sub AjoutProd()
Dim Stock       As Integer
Dim Retour      As Integer
Dim Retour2     As Integer
Stock = ActiveSheet.Range(C30).Value
If Stock = Yes Then
        Retour = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                 "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "My Film - " & ActiveSheet.Range("E76").Value & "mm wide film in stock", vbYesNoCancel, "Please Select your film option")
        Select Case Retour
            Case 6        'Oui
                ActiveSheet.Range("B76:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 2        'Annuler
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
        End Select
Else
        Retour2 = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                  "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  vbYesNo, "Please Select your film option")
        Select Case Retour2
            Case 6        'Oui
                ActiveSheet.Range("B77:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
        End Select
End If
End Sub
 

Pièces jointes

  • 400.png
    400.png
    7.3 KB · Affichages: 3

Zonmé

XLDnaute Nouveau
Merci @Franc58 , je viens de mettre les guillemets en question, du coup nouvelle erreur "Incompatibilité".
Peut-être cela vient de la fonction Option Explicit. Je ne connais pas du tout cette fonction, je vais essayer de regarder ce que je peux trouver. En tête de module, c.-à-d. en début de macro, comme les "Dim As Integer
"?
 

Franc58

XLDnaute Occasionnel
Option Explicit oblige à déclarer toutes les variables, ce qui peut éviter beaucoup d'erreurs. Il se place en tête de module, en dehors de toute macro. Le mieux est d'aller dans les options de l'éditeur VBA via le menu Outils - Options - Général et cocher la case "Déclaration des variables obligatoire", comme ça tu ne dois plus y penser.
 

Franc58

XLDnaute Occasionnel
Je me suis permis de réécrire ta macro, j'en ai créé 2 pour éviter la répétition de code et alléger la macro. J'ai ajouté des constantes pour plus de lisibilité. Non testé puisque pas de fichier. Utilise et adapte si/comme tu veux.

VB:
Option Explicit
Sub AjoutProd()
    Const YES_OPTION = 6
    Const NO_OPTION = 7
    Const CANCEL_OPTION = 2
    
    Dim Stock As String
    Dim Retour As Integer
    Dim message As String
    
    Stock = ActiveSheet.range("C30").Value
    message = "What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
    "Option 1 - " & ActiveSheet.range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
    "Option 2 - " & ActiveSheet.range("E78").Value & "mm wide film" & Chr(13) & Chr(10)
    
    If Stock = "Yes" Then
        message = message & "My Film - " & ActiveSheet.range("E76").Value & "mm wide film in stock"
        Retour = MsgBox(message, vbYesNoCancel, "Please Select your film option")
    Else
        Retour = MsgBox(message, vbYesNo, "Please Select your film option")
    End If
    
    Select Case Retour
    Case YES_OPTION, NO_OPTION, CANCEL_OPTION
        CopyData "B76:I77"
        CopyData "B79:I93"
        CopyValue "C18"
        range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
    End Select
End Sub

Sub CopyData(range As String)
    ActiveSheet.range(range).Copy
    With Sheets("Product List").range("B" & Rows.Count).End(xlUp).Offset(1)
        .PasteSpecial Paste:=xlPasteColumnWidths
        .PasteSpecial Paste:=xlPasteValues
    End With
End Sub

Sub CopyValue(range As String)
    ActiveSheet.range(range).Copy
    With Sheets("Product List").range("A" & Rows.Count).End(xlUp).Offset(1)
        .PasteSpecial Paste:=xlPasteValues
    End With
End Sub
 

Zonmé

XLDnaute Nouveau
Je ne connaissais pas, vraiment cool cette fonctionnalité.
Du coup ça m'a parmi de voir que ma variable Stock devait être en String et pas Integer.
La première option fonctionne nickel (avec 3 choix quand on a C30= "Yes".
Par contre pour la configuration ou C30 = "No" ou C30 = "" (vide), je me retrouve avec une erreur de compatibilité sans plus de précisions (genre 13 ou comme ça)
Par contre c'est important que j'i tout sur le même bouton et pas en macros séparées, mon tableau est déjà chargé... .

Mon code:
VB:
Sub AjoutProd()
Dim Stock       As String
Dim Retour      As Integer
Dim Retour2     As Integer
Stock = ActiveSheet.Range("C30").Value
If Stock = "Yes" Then
        Retour = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                 "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "My Film - " & ActiveSheet.Range("E76").Value & "mm wide film in stock", vbYesNoCancel, "Please Select your film option")
        Select Case Retour
            Case 6        'Oui
                ActiveSheet.Range("B76:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 2        'Annuler
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
        End Select
ElseIf Stock = "No" Or Stock = "" Then
        Retour2 = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                  "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  vbYesNo, "Please Select your film option")
        Select Case Retour2
            Case 6        'Oui
                ActiveSheet.Range("B77:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
        End Select
End If
End Sub
 
Dernière édition:

dysorthographie

XLDnaute Accro
Bonsoir,
VB:
Option Explicit

Sub AjoutProd()
    Dim Stock As String
    Dim Retour As VbMsgBoxResult
    Dim message As String
    
    Stock = ActiveSheet.Range("C30").Value
    
    message = "What film Option Do you want To add To your RfQ" & vbCrLf & _
              "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & vbCrLf & _
              "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & vbCrLf
    
    If Stock = "Yes" Then
        message = message & "My Film - " & ActiveSheet.Range("E76").Value & "mm wide film in stock"
        Retour = MsgBox(message, vbYesNoCancel, "Please Select your film option")
        Select Case Retour
            Case vbYes
                CopyData "B76:I77", "B79:I93"
                CopyValue "C18"
                ClearContents
            Case vbNo
                CopyData "B76:I76", "B78:I93"
                CopyValue "C18"
                ClearContents
            Case vbCancel
                CopyData "B76:I76", "B79:I93"
                CopyValue "C18"
                ClearContents
        End Select
    Else
        Retour = MsgBox(message, vbYesNo, "Please Select your film option")
        If Retour = vbYes Then
            CopyData "B77:I77", "B79:I93"
            CopyValue "C18"
            ClearContents
        ElseIf Retour = vbNo Then
            CopyData "B78:I93"
            CopyValue "C18"
            ClearContents
        End If
    End If
End Sub

Sub CopyData(ParamArray ranges() As Variant)
    Dim range As Variant
    For Each range In ranges
        ActiveSheet.Range(range).Copy
        With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial Paste:=xlPasteColumnWidths
            .PasteSpecial Paste:=xlPasteValues
        End With
    Next range
End Sub

Sub CopyValue(range As String)
    ActiveSheet.Range(range).Copy
    With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
        .PasteSpecial Paste:=xlPasteValues
    End With
End Sub

Sub ClearContents()
    Range("C16,C18,C20,C22,C24,C26,C28,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
End Sub
 

Franc58

XLDnaute Occasionnel
Je ne connaissais pas, vraiment cool cette fonctionnalité.
Du coup ça m'a parmi de voir que ma variable Stock devait être en String et pas Integer.
La première option fonctionne nickel (avec 3 choix quand on a C30= "Yes".
Par contre pour la configuration ou C30 = "No" ou C30 = "" (vide), je me retrouve avec une erreur de compatibilité sans plus de précisions (genre 13 ou comme ça)
Par contre c'est important que j'i tout sur le même bouton et pas en macros séparées, mon tableau est déjà chargé... .

Mon code:
VB:
Sub AjoutProd()
Dim Stock       As String
Dim Retour      As Integer
Dim Retour2     As Integer
Stock = ActiveSheet.Range("C30").Value
If Stock = "Yes" Then
        Retour = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                 "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                 "My Film - " & ActiveSheet.Range("E76").Value & "mm wide film in stock", vbYesNoCancel, "Please Select your film option")
        Select Case Retour
            Case 6        'Oui
                ActiveSheet.Range("B76:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 2        'Annuler
                ActiveSheet.Range("B76:I76").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
        End Select
ElseIf Stock = "No" Or Stock = "" Then
        Retour2 = MsgBox("What film Option Do you want To add To your RfQ" & Chr(13) & Chr(10) & _
                  "Option 1 - " & ActiveSheet.Range("E77").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  "Option 2 - " & ActiveSheet.Range("E78").Value & "mm wide film" & Chr(13) & Chr(10) & _
                  vbYesNo, "Please Select your film option")
        Select Case Retour2
            Case 6        'Oui
                ActiveSheet.Range("B77:I77").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("B79:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                   .PasteSpecial Paste:=xlPasteColumnWidths
                   .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
            Case 7        'Non
                ActiveSheet.Range("B78:I93").Copy
                With Sheets("Product List").Range("B" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteColumnWidths
                    .PasteSpecial Paste:=xlPasteValues
                End With
                ActiveSheet.Range("C18").Copy
                With Sheets("Product List").Range("A" & Rows.Count).End(xlUp).Offset(1)
                    .PasteSpecial Paste:=xlPasteValues
                End With
                Range("C16,C18,C20,C22,C24,C26,C28,C30,D35,D37,D39,D41,D43,D45,C49,C51,C53,C56,C58,C60,C62").ClearContents
        End Select
End If
End Sub
Seule la macro AjoutProd est appelée par le clic du bouton, les 2 autres sont appelées dans la macro.
Je ne vois pas le rapport entre les macros et le fait que ton tableau soit chargé.
 

Zonmé

XLDnaute Nouveau
Bonjour @Franc58 et @dysorthographie, vraiment merci à vous deux pour votre aide et support.
@Franc58, je n'avais réalisé que les macros séparées se mettaient en route via la première, bêtement je pensais devoir les déclencher "manuellement". Encore beaucoup de boulot de mon côté pour comprendre et bien maîtriser le VBA, mais c'est grâce à ce genre d'échange que ça arrivera!
Une fois de plus merci à vous deux, et à bientôt!
 

Discussions similaires

Statistiques des forums

Discussions
312 584
Messages
2 089 995
Membres
104 331
dernier inscrit
xdream