Macro inserer ligne si ...

[SWANLAKE]

Bonjour à tous,

voilà, je veux copier/insérer la ligne du dessous (avec des formules) a chaque fois que lorsque dans la colonne E je saisi une date (par exemple), ET SEULEMENT dans la colonne E.

Pour être plus explicite : je me mets sur la cellule E5, je saisie une date je tape sur la touche entrée, donc mon curseur se met sur la cellule E6, et donc là automatiquement il copie toute la ligne 6 et insère entr la ligne 6 et 7.

VOICI MA MACRO ET ELLE FONCTIONNE :

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False ' pour ne pas se mordre la queue
Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="aze"

L = ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Activate
K = ActiveCell.Column
If K = 5 Then
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Copy
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(rowOffset:=-2, columnOffset:=5).Select
Else
End If

ActiveSheet.Protect Password:="aze", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlUnlockedCells

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

En fait cette macro marche pour tout ce que je saisi dans le colonne E car j'ai limité la fonction avec le " If Then Else"
MAIS, il m'insère une ligne, aussi, quand je supprime une de ces dates (en fait quand j'efface le contenu d'une cellule). Donc j'ai essayé cette macro, mais ca ne marche pas :

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False ' pour ne pas se mordre la queue
Application.ScreenUpdating = False

ActiveSheet.Unprotect Password:="aze"


L = ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Activate
K = ActiveCell.Column
O = Selection
If Selection.ClearContents = True And ActiveCell.Column = 5 Then
Else
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Copy
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
Rows(ActiveCell.Row & ":" & ActiveCell.Row).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
ActiveCell.Offset(rowOffset:=-2, columnOffset:=5).Select
End If


ActiveSheet.Protect Password:="aze", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlUnlockedCells

Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

J'ai voulu rajouter un if pour lui dire que si dans la colonne E je fait un effacement du contenu d'une cellule (If Selection.ClearContents = True And ActiveCell.Column = 5), alors il ne fait rien sinon il insère une ligne (Else

AVEZ-VOUS UNE IDEE ? POUVEZ-VOUS M'AIDER ? EST CE POSSIBLE DE POUVOIR FAIRE CA OU JE SUIS TROP EXIGEANT ?

Merci beaucoup pour votre aide !

 

[Gorfael]

Re : Macro inserer ligne si ...

Salut SWANLAKE et le forum
Pas sûr de comprendre (à quoi sert L ?)

Private Sub Worksheet_Change(ByVal Target As Range)
'M.E.I. ===========================================
Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="aze"
'Validation des données ===========================
If Target.Cells.Count > 1 Or Target.Column <> 5 Then Exit Sub
'traitement =======================================
If Target <> "" Then
    Target.Row.Copy
    Rows(Target.Row + 1).Insert Shift:=xlDown
End If
' Remise à l'état initial =========================
Application.CutCopyMode = False
ActiveSheet.Protect Password:="aze", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingColumns:=True, AllowSorting:=True, AllowFiltering:=True
ActiveSheet.EnableSelection = xlUnlockedCells
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Quelques remarques en passant :
- Pas d'obligation d'utiliser un Offset si c'est pour pour décoler de 0
- Pas la peine d'utiliser le nom des paramètres nommés:
ActiveCell.Offset(1, 0) <=> ActiveCell.Offset(rowOffset:=1, columnOffset:=0).
- Utiliser "Activecell/selection et Select" est rarement une bonne idée : ça ne sert pas à grand chose, à part ralentir ton code.
A+

 

[SWANLAKE]

Re : Macro inserer ligne si ...

Merci Gorfael !

Désolé de te répondre et remercier si tard, mais je n'avais pas eu le temps de me repancher dessus. En fait j'ai trouvé plus simple !

La macro suivante efface le contenu (pas suprression) des cellules de AE6 à BM13 dans une feuille quand il trouve le signe "<" (que les cellules qui contient ce signe).

Evidement cette macro est adapatable, on peut mettre n'importe quel(s) mot(s) à la place du signe, et que la macro s'exécute pas seulement sur les cellules de AE6 à BM13.

Sub supprcontenucellulecontenantmot()

Dim cell As Range
On Error GoTo 88
For Each q In Range("AE6:BM13")
q = cells.Find(What:="<", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
If q = True Then
ActiveCell.Select
Selection.ClearContents
Else
Exit For
End If
Next q
88 End Sub