Vitesse d'insertion de ligne vide

Bonjour a tous,

J'utilise cette macro pour insérer des lignes vides, cela fonctionne super , le souci c'est que pour des fichiers contenant plus de Mille lignes , c'est très long

est il possible d'accélérer cela ?

For i = Ligne_Depart + 2 To N_b_lignes Step N_b_couleurs + 1
Rows(i).EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove

Et pour écrire des valeurs a intervalle régulières , j'utilise cela et c'est très long aussi

For k = 4 To N_b_lignes Step N_b_couleurs + 1
Cells(k, 20) = "Parent"

Merci de votre aide

bonjour,

une proposition

pour les lignes à copier

Sub aargh()
    Dim rtc As Object
    With Sheets("feuil2") ' à adapter
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        'insertion d'une colonne de numérotation des lignes
        .Columns(1).Insert
        .Range("A1") = 1
        .Range("A2") = 2
        .Range("A1:A2").AutoFill Destination:=.Range("A1:A" & dl), Type:=xlFillDefault
        'mémorisation des lignes à copier
        For i = 2 To dl Step 4 ' à adapter
            If rtc Is Nothing Then
                Set rtc = .Rows(i)
            Else
                Set rtc = Union(rtc, .Rows(i))
            End If
        Next i
        'copie des lignes à la suite des lignes existantes
        rtc.Copy .Cells(dl + 1, 1)
        ' tri des lignes suivant le numéro de ligne
        Rows("1:" & 2 * dl).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
        'suppression de la colonne contenant le numéro de ligne
        .Columns(1).Delete shift:=xlToLeft
    End With
End Sub

pour les cellules à modifier

Sub aaargh()
    With Sheets("feuil2") 'n° de colonne
        col = 1 ' à adapter n° de colonne
        dl = .Cells(Rows.Count, 1).End(xlUp).Row
        tabcol = .Cells(1, col).Resize(dl, 1)
        For i = 2 To dl Step 4
            tabcol(i, 1) = "parent"
        Next
        .Cells(1, col).Resize(dl, 1) = tabcol
    End With
End Sub

Merci bcp, j'ai un message d'erreur a l'exécution de cette ligne

.Range("A1:A2").AutoFill Destination:=.Range("A1:A" & dl), Type:=xlFillDefault

Le colonne s'insere bien , A1 = 1, A2 =2, puis erreur lors de la duplication des lignes vers le bas

En colonne 3, j'ai une vingtaine de valeurs

MErco

Pour le premier Cas , je cherche a inserer des lignes vides et non pas en copier certaines

Merci

bonjour,

Merci bcp, j'ai un message d'erreur a l'exécution de cette ligne

.Range("A1:A2").AutoFill Destination:=.Range("A1:A" & dl), Type:=xlFillDefault

Le colonne s'insere bien , A1 = 1, A2 =2, puis erreur lors de la duplication des lignes vers le bas

En colonne 3, j'ai une vingtaine de valeurs

MErco

Comme je n'ai pas ton fichier, je prends des options qui ne correspondent peut-être pas à ton fichier. En l'occurrence, je me base sur la première colonne du fichier dl = .Cells(Rows.Count, 1).End(xlUp).Row pour déterminer le nombre de lignes, colonne qui apparemment est vide dans ton fichier. Remplace le 1 dans la formule par n° de colonne qui convient.

Pour le premier Cas , je cherche a inserer des lignes vides et non pas en copier certaines

Merci

voici le code adapté

Sub aargh()
    Dim rtc As Object
    With Sheets("sheet1") ' à adapter
        dl = .Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne utilisée en colonne 1
        dc = .UsedRange.Columns.Count
        'insertion d'une colonne de numérotation des lignes
        .Columns(1).Insert
        .Range("A1") = 1
        .Range("A2") = 2
        .Range("A1:A2").AutoFill Destination:=.Range("A1:A" & dl), Type:=xlFillDefault
        'mémorisation des lignes à copier
        For i = 2 To dl Step 4 ' à adapter
            If rtc Is Nothing Then
                Set rtc = .Rows(i)
            Else
                Set rtc = Union(rtc, .Rows(i))
            End If
        Next i
        'copie des lignes à la suite des lignes existantes
        rtc.Copy .Cells(dl + 1, 1)
        Cells(dl + 1, 2).Resize(dl, dc).ClearContents 'on efface le contenu des lignes copiées mais on garde le format
        ' tri des lignes suivant le numéro de ligne
        Rows("1:" & 2 * dl).Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
        'suppression de la colonne contenant le numéro de ligne
        .Columns(1).Delete shift:=xlToLeft
    End With
End Sub