Macro, si case vide, afficher un message + stopper l'execution.

Bonjour,
1- si toutes tes cellules sont contigües, tu peux utiliser la syntaxe : Range("A1:A10").
Dans ton exemple :
Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15")
s'écrit avantageusement :
Range("D3:D15")

2- pour ton test :
Il te faut réaliser une boucle sur ce Range.
Tu peux procéder comme ceci, ajoute ce code en début de ta macro :

Dim MaPlage As Range, Cel As Range

Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
    If Cel.Value = "" Then 'si elle est vide alors
        'message à l'utilisateur
        MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
        'sortie de la procédure
        Exit Sub
    End If
Next

Cordialement,
Franck P

Merci pijaku de ta réponse c'est exactement cela.

Pour la synthaxe, c'est vrai que la mienne était un peu barbard. Je l'ai donc modifié en conséquence, au vu des différents questionnaire que j'ai du crée elle ne sont pas toujours contigües.

Pour avoir le même travail effectuer au niveau des cellules G j'ai ajouter a la suite une autre boucle.
J'ai essayé de mettre Range("D3:D15;G3:G16) mais cela n'a pas fonctionné.

Merci pour tout partage de connaissance pijaku. Bonne journée :).

Macro final:

Sub ajouter_un_produit()

Dim MaPlage As Range, Cel As Range

Set MaPlage = Sheets("ajout_produit_composant").Range("D3:D15")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
If Cel.Value = "" Then 'si elle est vide alors
'message à l'utilisateur
MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
'sortie de la procédure
Exit Sub
End If
Next

Set MaPlage = Sheets("ajout_produit_composant").Range("G3:G15")
For Each Cel In MaPlage 'pour toutes les cellules de la plage
If Cel.Value = "" Then 'si elle est vide alors
'message à l'utilisateur
MsgBox "La cellule : " & Cel.Address & " n'est pas remplie."
'sortie de la procédure
Exit Sub
End If
Next

Application.ScreenUpdating = False
Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15").Copy
Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(1, 0)
Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
Application.ScreenUpdating = False
Sheets("ajout_produit_composant").Range("G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").Copy
Set Derligne = Sheets("tableau").Range("$A$65536").End(xlUp).Offset(0, 13)
Derligne.PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
Sheets("ajout_produit_composant").Range("D3,D4,D5,D6,D7,D8,D9,D10,D11,D12,D13,D14,D15,G3,G4,G5,G6,G7,G8,G9,G10,G11,G12,G13,G14,G15,G16").ClearContents
Application.CutCopyMode = False

End Sub

Bonjour

Voila ta macro modifier
A tester bien sur

Sub ajouter_un_produit()
Application.ScreenUpdating = False
With Feuil2
For L = 3 To 13
If .Range("D" & L).Value = "" Then
MsgBox "Veuillez répondre à toutes les questions"
Exit Sub
End If
Next
For L = 3 To 16
If .Range("G" & L).Value = "" Then
MsgBox "Veuillez répondre à toutes les questions"
Exit Sub
End If
Next
.Range("D3:D15").Copy
DerLigne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
Feuil1.Range("A" & DerLigne).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
.Range("G3:G16").Copy
DerLigne = Feuil1.Range("A" & Rows.Count).End(xlUp).Row + 1
Feuil1.Range("A" & DerLigne).PasteSpecial Paste:=xlAll, Operation:=xlNone, Transpose:=True
.Range("D3:D15").ClearContents
.Range("G3:G16").ClearContents
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

A+

Maurice

Merci Maurice, j'ai pas pu tester l'effet car même aprés avoir rempli mes questions, la message box reste et la macro ne s'execute pas.