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

Z

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: 3
Solution
F
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)...
Trier par date Trier par votes
Z

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: 4
Vote positif 0 Vote négatif
Z

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
"?
 
Vote positif 0 Vote négatif
F

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.
 
Vote positif 0 Vote négatif
F

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
 
Vote positif 0 Vote négatif
Solution
Z

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:
Vote positif 0 Vote négatif
dysorthographie

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
 
Vote positif 0 Vote négatif
F

Franc58

XLDnaute Occasionnel
Zonmé à dit:
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
Cliquez pour agrandir...
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é.
 
Vote positif 0 Vote négatif
Z

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!
 
Vote positif 0 Vote négatif

Discussions similaires

O
  • Question
XL 2019 Je veux afficher mes données dans ma Listbox1 avec l'entete de ma Base donnée et fait la recherche sans que cela derange l'entete.
Réponses
6
Affichages
767
ChTi160
ChTi160
C
  • Question
Microsoft 365 VBA erreur impossible de lire la propriete pastespecial de la classe range
Réponses
2
Affichages
1 K
Catsnroses
C
C
  • Résolu(e)
XL 2016 Remplir automatiquement un tableau d'après des conditions et des valeurs
Réponses
11
Affichages
1 K
ERIC S
ERIC S
C
  • Question
XL 2019 Erreur 438 sur un specialPaste
Réponses
6
Affichages
1 K
Cheyenne_2021
C
Usine à gaz
  • Question
Microsoft 365 Gros problème de ralentissement au lancement d'un inputbox
3 4 5
Réponses
60
Affichages
5 K
soan
S
M
  • Question
Microsoft 365 Simplification de Code
Réponses
4
Affichages
1 K
MarcMad
M
I
  • Question
XL 2016 Copier/Coller valeurs Erreur 1004
Réponses
2
Affichages
1 K
isataz
I
Z
  • Résolu(e)
XL 2013 erreur d’exécution 91 "variable de bloc With non définie"
2
Réponses
22
Affichages
3 K
xUpsilon
xUpsilon
V
  • Résolu(e)
XL 2013 Problème exécution macro (fermeture automatique)
Réponses
13
Affichages
3 K
Dranreb
Dranreb
S
  • Question
XL 2016 vba : Faire une recherche de données dans fichier externe fermé
Réponses
12
Affichages
3 K
James007
James007

Membres actuellement en ligne

1 membres et 33 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 087
Messages
2 116 083
Membres
112 654
dernier inscrit
SADIKA