Insérer et copier une ligne automatique selon une condition

Le 10/08/2015 à 18:12

Bonjour à tous

je cherche une macro qui insérait une ligne automatique en dessous de la ligne de référence et qui reprendrait les renseignements des cellules A@G sur la nouvelle ligne si la cellule de la colonne O est rempli.

Par exemple, si j'insert un x en O1, j'aimerais que les informations de A1:G1 et la mise en forme de toutes les cellules de la ligne soient reprise sur une ligne suivante. À la ligne 2, il se peut qu'il y a déjà des renseignements de saisis, lesquels devraient se retrouver à la ligne 3, ainsi de suite.

J'ai consulté bon nombre de posts, mais je n'ai rien trouvé qui s'y apparente.

Merci d'avance pour votre précieuse aide.

Le 10/08/2015 à 19:50

Bonjour Michel, bonjour le forum,

• Copie le code ci-dessous :

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim LI As Integer 'déclare la variable LI (LIgne)

If Target.Column <> 15 Then Exit Sub 'si le changement a lieu ailleurs qu'en colonne 15 (=O), sort de la procédure
If UCase(Target.Value) = "X" Then 'conditionsi un "x" ou "X" est écrit
    LI = Target.Row 'définit la ligne LI
    Rows(LI).Copy 'copie la ligne LI
    Rows(LI + 1).Insert Shift:=xlDown 'insère la ligne LI dan sla ligne ed-dessous
    Range(Cells(LI + 1, 8), Cells(LI + 1, Application.Columns.Count)).ClearContents 'efface le contenu de H à la dernière colonne
    Cells(LI + 1, 8).Select 'place le curseur dans la première cellule vide colonne H
End If 'fin de la condition
End Sub

• Clique avec le bouton droit dans le nom de l'onglet en bas

• Choisis l'option Visualiser le code

• Colle le code où le curseur clignote

• Ferme VBE (l'Éditeur Visual Basic) avec le raccourci clavier [Alt]+[F11]

• Sauve ton classeur

Chaque fois que tu écriras x ou X dans la colonne O la ligne sera copiée

Le 10/08/2015 à 20:37

Bonjour ThauThème

merci pour votre réponse rapide.

Le code semble approprié, mais je dois double cliqué pour que la ligne s'ajoute et recopie les info. C'est sans doute du au fait que l'inscription de la valeur en O s'inscrit automatiquement en double cliquant dans la cellule.

Voici mon code

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    adresse = Target.Address
    For i = 5 To 65536
        If adresse = "$I$" & i Then
            Calendrier.Show
            Cancel = True
            Exit For
        ElseIf adresse = "$H$" & i Then
            UserForm1.Show
            Cancel = True
            Exit For
        End If
    Next

'au changement dans l'onglet
Dim LI As Integer 'déclare la variable LI (LIgne)

If Target.Column <> 15 Then Exit Sub 'si le changement a lieu ailleurs qu'en colonne 15 (=O), sort de la procédure
If UCase(Target.Value) = "O" Then 'conditionsi un "O" est écrit
   LI = Target.Row 'définit la ligne LI
   Rows(LI).Copy 'copie la ligne LI
   Rows(LI + 1).Insert Shift:=xlDown 'insère la ligne LI dans la ligne en-dessous
   Range(Cells(LI + 1, 8), Cells(LI + 1, Application.Columns.Count)).ClearContents 'efface le contenu de H à la dernière colonne
   Cells(LI + 1, 8).Select 'place le curseur dans la première cellule vide colonne H
End If 'fin de la condition

End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  temp = Array("O", "")
  If Not Application.Intersect(Target, Range("K05:L65000, M05:O65000")) Is Nothing Then
    With Target
  p = Application.Match(Target, temp, 0)
  If Not IsError(p) Then
    If p = UBound(temp) + 1 Then p = 0
  Else
    p = 0
  End If
  Target = temp(p)
  Cancel = True
  End With
  End If

End Sub

Q'en pensez-vous? Dans ce cas, le code doit-il être modifié?

Merci

Le 10/08/2015 à 21:43

Re,

Le problème est que tu nous parles d'un "x" dans la colonne O uniquement alors le code du Double-Clic ci-dessous (que tu navet pas fourni dans ton premier post) renvoie "O" (et non pas "x") au double-clic dans les colonnes K à O !...

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  temp = Array("O", "")
  If Not Application.Intersect(Target, Range("K05:L65000, M05:O65000")) Is Nothing Then
    With Target
  p = Application.Match(Target, temp, 0)
  If Not IsError(p) Then
    If p = UBound(temp) + 1 Then p = 0
  Else
    p = 0
  End If
  Target = temp(p)
  Cancel = True
  End With
  End If
 End Sub

Donc il faudrait savoir exactement ce que tu veux pour te proposer une solution adaptée.

Commence par tout virer et utilise les deux événementielles ci-dessous :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
temp = Array("O", "")
If Not Application.Intersect(Target, Range("K05:L65000, M05:O65000")) Is Nothing Then
    With Target
        p = Application.Match(Target, temp, 0)
        If Not IsError(p) Then
            If p = UBound(temp) + 1 Then p = 0
        Else
            p = 0
        End If
        Target = temp(p)
        Cancel = True
    End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range) 'au changement dans l'onglet
Dim LI As Integer 'déclare la variable LI (LIgne)

If Target.Row < 5 Then Exit Sub 'si le changement a lieu dans une ligne inférieure à 5, sort de la procédure
Select Case Target.Column 'agit en fonction de la colonne de la cellule éditée
    Case 11 To 15 'colonnes 11 à 15 (=K à O)
        If UCase(Target.Value) = "O" Then 'conditionsi un "o" ou "O" est écrit
           LI = Target.Row 'définit la ligne LI
           Rows(LI).Copy 'copie la ligne LI
           Rows(LI + 1).Insert Shift:=xlDown 'insère la ligne LI dan sla ligne ed-dessous
           Range(Cells(LI + 1, 8), Cells(LI + 1, Application.Columns.Count)).ClearContents 'efface le contenu de H à la dernière colonne
           Cells(LI + 1, 8).Select 'place le curseur dans la première cellule vide colonne H
        End If 'fin de la condition
End Select
End Sub

La première va écrire un "O" en double-cliquant à partir de la ligne 5 dans les colonne K à O.

la seconde va copier la ligne si elle voit un "O" dans les colonnes K à O à partir de la ligne 5.

Sommes-nous d'accord ?...

Le 10/08/2015 à 22:27

Bonjour ThauThème

Désolé pour la confusion. En fait, je souhaite qu'une ligne s'ajoute à la suite seulement quand j'ajoute un "O" dans la colonne O, pas pour les autres colonnes.

L'inscription du "O" se fait en double cliquant dans la cellule K@L et deM@O.

J'ai quand même besoin de l'insertion au double clic du calendrier et de l'autre l'userform1.

Votre premier code fonctionne très bien seulement quand je re-clique sur la cellule de la colonne O pour laquelle j'ai besoin d'une duplication!

Merci infiniment pour votre aide, et désolé encore pour le contre-temps.

Le 11/08/2015 à 00:46

Re,

• Je comprends maintenant la confusion entre "O" et "x" qui est le symbole affiché par la police Wingdings2 quand on écrit un O majuscule.

• Je ne comprends pas ce que fait la procédure Liste_deroulante dans le composant Feuill1(Registre). Ça place devrait plutôt se trouver dans un module standard (Module1 par exemple), mais comme rien rien ne l'appelle c'est vrai que tu peux la mettre où tu veux !...

Bon voici ton fichier modifié en pièce jointe. Tu avais fait un mix des événementielles Change et SelectionChange. J'ai remis tout ça en ordre...

30michel-v01.zip (70.24 Ko)
Le 11/08/2015 à 15:28

Bonjour ThauThème

merci beaucoup pour cette mise au point. J'ai suivi votre conseil, j'ai déplacé le code de la liste déroulante dans un module. Par contre, pour une raison que j'ignore, je n'obtiens pas tous les éléments de la liste. Dans la liste, j'ai 5 éléments, alors que sur le fichier j'en n'obtiens que 4, le premier "Hors délai" est manquant.

Sub Liste_deroulante()

'--- Déclaration des variables
Dim Plage_Listes As Range
Dim Liste As String

'--- Initialisation des variables
Set Plage_Listes = ActiveSheet.Columns("P")
Liste = "Hors délai, Raison personnelle, Sans raison, Travaille déjà, Trop hrs/semaine"

'--- Génération de la liste déroulante
With Plage_Listes.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Liste
    .IgnoreBlank = False
    .InCellDropdown = True
    .ShowInput = True
    .ShowError = True
End With

End Sub

Merci

Le 11/08/2015 à 17:14

Re,

Chez moi ça marche mais dans le doute je remplacerais :

Set Plage_Listes = ActiveSheet.Columns("P")

par :

Set Plage_Listes = Sheets("Registre").Columns("P")

Mais tu ne me dis même pas si le reste, qui était finalement le propos de ton fil, fonctionne ou pas !...

Le 11/08/2015 à 20:51

Bonsoir ThauThème

Merci pour tout. C'est impeccable. Tout fonctionne bien hormis mon souci avec la liste déroulante. J'ai fait le changement comme vous me l'avez suggéré, mais la liste reste incomplète.

Je me demandais si le code pour ajouter une ligne automatique ne pouvais pas être générique, c'est-à-dire peut importe la valeur qui se trouve dans la cellule de la colonne O par exemple, une ligne s'ajouterait!

Merci encore pour tout et à bientôt

Le 11/08/2015 à 21:23

Re,

Je ne comprends pas pourquoi ça ne fonctionne pas chez toi pour la validation de données alors que chez moi c'est nickel ?!...

Pour que le code fonctionne quelle que soit le texte édité, remplace dans l'événementielle Change :

If UCase(Target.Value) = "O" Then 'conditionsi un "O" est écrit

par :

If Target.Value <> "" Then
Le 11/08/2015 à 21:56

Super ThauThème

j'ai vérifié dans la Données/Validation, et il manquait en effet le "Hors délai". Je l'ai ajouté manuellement, et la liste déroulante est désormais complète.

Par curiosité, j'ai tenté d'appliquer cette macro à une autre fichier, et mystérieusement elle ne fonctionne plus. bref pour l'instant, j'ai d'autres priorités sur d'autre dossiers. J'y verrai plus tard.

Merci infiniment pour votre précieuse aide.

Rechercher des sujets similaires à "inserer copier ligne automatique condition"