Autres Insertion ligne en auto

[candido57]

Bonjour,

J’ai un fichier avec des dates (colonne A) et je voudrais en auto insérer des lignes à chaque nouvelle date, puis copier dans ces insertion les titres en ligne 4.
J’ai une macro, mais ça ne fonctionne pas au top et la ligne 4 ne se copie pas

Sub essai()
Application.ScreenUpdating = False
Dim Ligne As Long
For Ligne = Range("65536").End(xlUp).Row To 2 Step -1
If Left(Range("A" & Ligne), 1) <> Left(Range("A" & Ligne - 1), 1) Then
Range("A" & Ligne).EntireRow.Insert
Range("A" & Ligne) = Range("A4")
End If
Next
Application.ScreenUpdating = False
End Sub

 

[sylvanu]

Bonjour Candido,
Un essai en PJ avec :

Sub essai()
Application.ScreenUpdating = False
Dim Ligne As Long
For Ligne = Range("A65536").End(xlUp).Row To 6 Step -1
If IsDate(Range("A" & Ligne)) And IsDate(Range("A" & Ligne - 1)) Then
    If Range("A" & Ligne) <> Range("A" & Ligne - 1) Then
        Range("A" & Ligne).EntireRow.Insert
        Range("A4:F4").Copy Destination:=Range("A" & Ligne)
    End If
End If
Next
Application.ScreenUpdating = False
End Sub

Plutot que de regarder le caractère à gauche, je vérifie les dates.
De plus je vérifie si les cellules contiennent bien une date pour éviter qu'en relançant une seconde fois la macro on est des dédoublements de ligne d'entête.

 

[candido57]

Bonjour Sylvanu,

Merci beaucoup pour ton aide, ça fonction bien

Bonne journée