A voir également:
- VBA récupérer une valeur entrée par l'utilisateur dans excel
- Liste déroulante excel - Guide
- Excel trier par ordre croissant chiffre - Guide
- Recuperer message whatsapp supprimé - Guide
- Déplacer une colonne excel - Guide
- Word et excel gratuit - Guide
3 réponses
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 :
Cdt
Lupin
É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
Bonjour,
Code modifié selon la demande :
Cdt
Lupin
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
Bonjour,
Peut-être + simple et sans boucle
b165 correspond à 100 dans D15
regarde si cette maquette peut t'aider
https://www.cjoint.com/?3DojCVHxkiG
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
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+