XL 2013 Macro pour faire copie-coller

lestoiles1 · 5 Juin 2021

Bonjour à tous,

J'aimerais que lorsque je saisie un numero matricule dans la colonne B , lorsque j'apuis sur entrée à la fin du saisie, ça copie automatiquement en bas jusqu'à ce qu'il trouve une cellule vide dans la colonne A. Par exemple le 13918 jusqu'à la ligne 14.

Merci d'avance

Lestoiles1

lestoiles1 · 5 Juin 2021

Merci pour votre réponse mais je ne comprend pas tres bien, je fait double clique et une boite de dialogue s'affiche, je sais le numero matricule , puis je clique sur "ajout" , il ne se passe rien.

Compte Supprimé 979 · 5 Juin 2021

GALOUGALOU à dit:
Bonjour les étoiles bonjour le forum
Je ne suis pas raccord avec votre demande, mais je vous propose une solution par double clic dans la colonne B, qui ouvrira un formulaire. Le bouton ajout renseignera la colonne b à la suite de la 2ᵉ cellule vide colonne A
cordialement
galougalou

Vous êtes marrant vous
Qu'est-ce que ça veut dire "ne pas être raccord"... imposer sa volonté !?

Compte Supprimé 979 · 5 Juin 2021

Bonjour Lestoiles1

Voici le code à mettre dans le code de la feuille

et qui fait exactement ce que vous demandez

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim dlig As Long, pLig As Long, Matricule As String
  ' Si supresssion donnée simple ou multiple
  If Target.Resize(1, 1).Value = "" Then Exit Sub
  ' Se pas dans la colonne B on sort
  If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
  ' Mémoriser les infos
  Matricule = Target.Value: pLig = Target.Row: dlig = pLig
  ' Parcourir les lignes jusqu'à cellule vide
  Do While Range("A" & dlig).Value <> ""
    dlig = dlig + 1
  Loop
  ' Désactiver les évènements
  Application.EnableEvents = False
  ' Case vide on inscrit le matricule sur toute la plage
  Range("B" & pLig & ":B" & dlig - 1).Value = Matricule
  Range("B" & dlig + 1).Select
  ' Réactiver les évènements
  Application.EnableEvents = True
End Sub

@+

lestoiles1 · 5 Juin 2021

BrunoM45 à dit:

Bonjour Lesetoiles1

Voici le code à mettre dans le code de la feuille
Regarde la pièce jointe 1107555

et qui fait exactement ce que vous demandez

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim dlig As Long, pLig As Long, Matricule As String
  ' Si supresssion donnée simple ou multiple
  If Target.Resize(1, 1).Value = "" Then Exit Sub
  ' Se pas dans la colonne B on sort
  If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
  ' Mémoriser les infos
  Matricule = Target.Value: pLig = Target.Row: dlig = pLig
  ' Parcourir les lignes jusqu'à cellule vide
  Do While Range("A" & dlig).Value <> ""
    dlig = dlig + 1
  Loop
  ' Désactiver les évènements
  Application.EnableEvents = False
  ' Case vide on inscrit le matricule sur toute la plage
  Range("B" & pLig & ":B" & dlig - 1).Value = Matricule
  Range("B" & dlig + 1).Select
  ' Réactiver les évènements
  Application.EnableEvents = True
End Sub

@+

Merci , c'est exactement ce que je voulais

lestoiles1 · 7 Juin 2021

BrunoM45 à dit:

Bonjour Lesetoiles1

Voici le code à mettre dans le code de la feuille
Regarde la pièce jointe 1107555

et qui fait exactement ce que vous demandez

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim dlig As Long, pLig As Long, Matricule As String
  ' Si supresssion donnée simple ou multiple
  If Target.Resize(1, 1).Value = "" Then Exit Sub
  ' Se pas dans la colonne B on sort
  If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
  ' Mémoriser les infos
  Matricule = Target.Value: pLig = Target.Row: dlig = pLig
  ' Parcourir les lignes jusqu'à cellule vide
  Do While Range("A" & dlig).Value <> ""
    dlig = dlig + 1
  Loop
  ' Désactiver les évènements
  Application.EnableEvents = False
  ' Case vide on inscrit le matricule sur toute la plage
  Range("B" & pLig & ":B" & dlig - 1).Value = Matricule
  Range("B" & dlig + 1).Select
  ' Réactiver les évènements
  Application.EnableEvents = True
End Sub

@+

Une dernière chose svp, j'aimerais ajouter 8 a côtes de chaque première matricule ,comme dans le pj svte: (dans la colonne C), Pourriez vous me donner le macro svp?
Merci
lestoiles

Compte Supprimé 979 · 7 Juin 2021

Bonjour lestoiles1

Voici le code modifié

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim dlig As Long, pLig As Long, Matricule As String
  ' Si supresssion donnée simple ou multiple
  If Target.Resize(1, 1).Value = "" Then Exit Sub
  ' Se pas dans la colonne B on sort
  If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
  ' Mémoriser les infos
  Matricule = Target.Value: pLig = Target.Row: dlig = pLig
  ' Parcourir les lignes jusqu'à cellule vide
  Do While Range("A" & dlig).Value <> ""
    dlig = dlig + 1
  Loop
  ' Désactiver les évènements
  Application.EnableEvents = False
  ' 2021/06/07 : La cellule modifiée est la 1ère de la liste, on inscrit 8 sur la colonne de droite
  Target.Offset(0, 1).Value = 8
  ' Case vide on inscrit le matricule sur toute la plage
  Range("B" & pLig & ":B" & dlig - 1).Value = Matricule
  Range("B" & dlig + 1).Select
  ' Réactiver les évènements
  Application.EnableEvents = True
End Sub

@+

XL 2013 Macro pour faire copie-coller

lestoiles1

XLDnaute Occasionnel

Pièces jointes

lestoiles1

XLDnaute Occasionnel

Compte Supprimé 979

Guest

Compte Supprimé 979

Guest

lestoiles1

XLDnaute Occasionnel

lestoiles1

XLDnaute Occasionnel

Pièces jointes

Compte Supprimé 979

Guest

Discussions similaires