bonjour Zon
Merci bcp pour ta réponse !
Malheureusement, g essayé ta solution, mais ça marche pas...sans doute parce que le code est un peu compliqué et je n'arrive pas à l'adapter dans le mien ...
Voici la tête du code que je voudrais affecter au bouton qui se créé automatiquement dans une feuille excel. Pour l'instant, je l'ai écrit dans un module :
Private Sub procedurecontrole()
Dim reponse, MyValue
For Each C In Range(Range("H7"), Range("H200").End(xlUp)) 'Passer en revue les cellules de la zone SAISIE de la colonne A
'contrôler qu'une quantité a bien été entrée à côté des PU
If C.Offset(0, 1) = "" Then 'regarder dans la cellule de la même ligne (0), à droite (1)
C.Select
reponse = MsgBox("Attention ! vous avez oublié d'entrer une quantité ! Souhaitez vous corriger ?", vbYesNo + vbCritical + vbDefaultButton2, "CORRECTION ") ' affiche le message
If reponse = vbYes Then ' si l'utilisateur a choisi oui.
MyValue = InputBox("Veuillez entrer votre correction !", "Nouvelle Quantité", "") ' Affiche le message, le titre et la valeur par défaut.
C.Offset(0, 1) = MyValue ' Correction
End If
End If
Next
'calcul du cout total
Range("J7").Select
numlign = 7
Do While ActiveCell.Value <> "" 'tant qu'il n'y a rien dans la cellule active (C9),
numlign = numlign + 1 'ne pas changer de ligne ; sinon incrémenter numlign
cells(numlign, "J").Select 'sélectionner la 1ere cellule vierge
Loop
'selectionne la 1ere cellule disponible
ActiveCell.Select
ActiveCell.FormulaR1C1 = "=SUM(R7C10:R[-1]C)" 'faire la somme de J7 (Row7Col10) à 1 ligne au dessus de la cellule active
miseenforme
ActiveCell.Offset(0, -2).Select
ActiveCell = "Cout total"
miseenforme
ActiveCell.Offset(0, 1).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
ActiveCell.Offset(0, 2).Copy
Sheets("pdt interm").Select
Range("F4").Select
numlign = 4
Do While ActiveCell.Value <> "" 'tant qu'il n'y a rien dans la cellule active (C9),
numlign = numlign + 1 'ne pas changer de ligne ; sinon incrémenter numlign
cells(numlign, "f").Select 'sélectionner la 1ere cellule vierge
Loop
ActiveSheet.Paste link:=True
Sheets(nom).Select
Range("D3").Select
Sheets("pdt interm").Select
Range("A4").Select
numlign = 4
Do While ActiveCell.Value <> "" 'tant qu'il n'y a rien dans la cellule active (C9),
numlign = numlign + 1 'ne pas changer de ligne ; sinon incrémenter numlign
cells(numlign, "A").Select 'sélectionner la 1ere cellule vierge
Loop
ActiveSheet.Paste link:=True
End Sub
J'espere qu'il est possible d'affecter ce code au bouton de commande.
Ca serait sympa si qqun pouvait m'aider ....
Alex