Sujet Précédent Sujet Suivant

VBA récupérer une valeur entrée par l'utilisateur dans excel

Fermé
omarito - 12 avril 2011 à 10:35
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 - 14 avril 2011 à 09:29
Bonjour,

Je n'ai jamais fait de VBA et j'ai besoin d'un pgramme super simple svp.

L'utilisateur rentre un nombre, X, dans une cellule (dans mon cas D15)
Je veux un programme qui séléctionne une range: Range("B61:O61").Select
et qui la copie X fois dans les lignes du dessous.
Ex si X=23, la range sera copiée dans les lignes 62,63...et 84
"Selection.AutoFill Destination:=Range("B61:O84")"

Je ne sais pas comment intégrer le X de l'utilisateur

Il me faudrait un bouton ensuite à coté de la cellule D15 qui déclencher le "programme"
NB: si l'utilisateur rentre ensuite 3, le programme ne doit laisser que 62,63 et 64 et effacer 65 à 84 (il doit réinitialiser en fait...)

J'espère que c'est pas trop confus.
Je vous remercie bcp pour votre aide.
A voir également:

3 réponses

Réponse 1 / 3
Utilisateur anonyme
12 avril 2011 à 13:45
Bonjour,

Étape 1 :
Ouvrir VBE (Visual Basic Editor)

// Menu / Outils / Macro / Visual Basic Editor -> [Alt] [F11]

Supposons que la cellule D15 est sur la feuille 1.

Dans l'éditeur, regarder à gauche, la fenêtre qui se nomme
[ Projet - VBAProject ], vous y voyer le nom de ton classeur
Excel, repère la feuille 1 [ Feuil1] et effectue un double clic
dessus.

Tu attérit dans la fenêtre de droite, colle y le code suivant : 

Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Valeur As Long, Boucle As Long
    
    Application.EnableEvents = False
    
    If Not (Intersect(Target, Range("D15"))) Then
        Valeur = CLng(Target.Value)
        Range("B61:O61").Select
        Selection.Copy
        Range("B62").Select
        For Boucle = 1 To Valeur
            ActiveSheet.Paste
            ActiveCell.Offset(1, 0).Select
        Next Boucle
        Application.CutCopyMode = False
    End If
    
    
    Application.EnableEvents = True
    
End Sub
'


Cdt

Lupin
0
omarito
13 avril 2011 à 16:36
Salut Lupin

Merci bcp pour ta réactivité.
ça semble marcher... cependant si lutilisateur rentre un 2 éme nbre inférieur au 1er, il faudrait que le programme supprime les lignes en plus sans beuguer...
ex: il rentre 20, la ligne est copiée 20 fois, puis il se rend compte que c'est bcp et tape 15... le programme doit réinitialiser et ne copier que 15 lignes...

J'espère que c clair
et merci bcp pour ton aide très précieuse.
A+
0
Réponse 2 / 3
Utilisateur anonyme
13 avril 2011 à 17:03
Bonjour,

Code modifié selon la demande : 

Option Explicit
'

Private Sub Worksheet_Change(ByVal Target As Range)

    Static Nombre As Long
    Dim Valeur As Long, Boucle As Long
    
    Application.EnableEvents = False
    
    If Not (Intersect(Target, Range("D15"))) Then
        Valeur = CLng(Target.Value)
        If (Valeur < Nombre) Then
            DetruitLigne (Nombre)
        End If
        Nombre = Valeur
        Range("B61:O61").Select
        Selection.Copy
        Range("B62").Select
        For Boucle = 1 To Valeur
            ActiveSheet.Paste
            ActiveCell.Offset(1, 0).Select
        Next Boucle
        Application.CutCopyMode = False
    End If
    
    
    Application.EnableEvents = True
    
End Sub
'

Private Sub DetruitLigne(ByVal Nombre As Long)

    Dim Boucle As Long
    
    Range("B62").Select
    For Boucle = 1 To Nombre
            ActiveCell.EntireRow.Delete
    Next Boucle
    
End Sub
'


Cdt

Lupin
0
Réponse 3 / 3
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 310
14 avril 2011 à 09:29
Bonjour,

Peut-être + simple et sans boucle 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lig As Integer
If Not Intersect(Target, Range("D15")) Is Nothing And Target.Count = 1 Then
     lig = Range("B165").End(xlUp).Row + 1
     Application.EnableEvents = False
       Range("B62:O" & lig).Clear
       If Target <> "" Then Range("B61:O" & 61 + Target).FillDown
     Application.EnableEvents = True
End If

End Sub

b165 correspond à 100 dans D15

regarde si cette maquette peut t'aider
https://www.cjoint.com/?3DojCVHxkiG
0