J'utilise la macro ci-dessous et j'aimerais qu'une personne me donne une phrase de code pour qu'elle fasse quelquechose en plus :).
La voici:
Sub ajouter_un_produit()
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
En gros, elle copie des cellules D et G de la feuille 2 et les colles sur la feuille 1. Ensuite cela supprime les case D et G. et Arrête le mode copier avec le Application.CutCopyMode=False.
Cette macro fonctionne parfaitement, celle-ci m'aide dans une sorte de questionnaire.
Dans ce questionnaire j'aimerais qu'aucune cellule D et G ne soit vide avant d'être copier. J'aimerais donc ajouter une phrase qui permettrait de vérifier si les celllules D et G sont vides, et si l'une est vide pouvoir afficher le message: Veuillez répondre à toutes les questions. Et que cela stop la suite de la macro.
Si les cellules sont vides c'est bien évidement grâce à la phrase ClearContents. Afin que chaque utilisateur soit en face d'un questionnaire sans réponses.
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
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
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
