Macro pour insérer des lignes et les copier

Bonjour à tous.

J'ai un petit souci avec une macro. Le sujet à sans doute déjà été traité ailleurs mais je ne trouve pas.

Je cherche à créer une macro qui me permet d'insérer des données dans un tableau excel. Ces données sont basiques et figées dans des cellules du tableau. Jusque là pas de souci.

La partie plus complexe de ma macro est la suivante. Je voudrais insérer un nombre x de ligne en dessous une ligne de référence et recopier le format, les formules etc dans les lignes insérées.

Pour l'insertion de ligne selon un nombre indiqué dans un userform, pas de souci.

Par contre je bloque lorsque je veux copier la ligne de référence dans ces nouvelles lignes fraichement insérées.

Voici le code ma macro et le fichier joint.

Merci d'avance

Vincent

Private Sub CommandButton3_Click()
    'insere données base
    Sheets("Estimation").Select
    Range("C3").Value = TextBox3.Value
    Sheets("Estimation").Select
    Range("C4").Value = TextBox4.Value
    Sheets("Estimation").Select
    Range("A1").Value = TextBox1.Value
    'insere lignes lots
    If TextBox2 > 0 Then
    For i = 1 To TextBox2
        Range("a7").Select
        ActiveCell.EntireRow.Insert Shift:=xlDown
    Next i
    End If
    'copie ligne référence

    End
End Sub
476estimrapide.xlsm (21.67 Ko)

Bonjour Vincent,

Il y a plusieurs façons de faire, voici une proposition en partant de ton code. (essaie d'éviter les Select, ça ralentit le code).

Private Sub CommandButton3_Click()

    With Sheets("Estimation")
    'insere données base
        .Range("C3").Value = TextBox3.Value
        .Range("C4").Value = TextBox4.Value
        .Range("A1").Value = TextBox1.Value
    'insere lignes lots
        If TextBox2 > 0 Then
        For i = 1 To TextBox2
            .Range("a7").EntireRow.Insert Shift:=xlDown
        Next i
        End If
    'copie ligne référence
        .Range("A6:D6").Copy .Range("A6").Offset(1, 0).Resize(TextBox2, 4)  'Copie
        .Range("A6").Offset(1, 1).Resize(TextBox2, 1).ClearContents        'Efface la colonne B
    End With

    End
End Sub

A+

Bonjour Grand Chaman,

Tout d'abord merci pour ton aide.

J'ai bien appliqué ton code mais il me fait une erreur depuis l'insertion de la commande "With" en debut de macro.

Il ne comprend pas apparremment. Il me fait erreur 1004.

Merci d'avance.

RECTIFICATION :

J'avais mal copié le code. Il fonctionne très bien mais le souci c'est qu'il m'efface tout le contenu alors que je veux au contraire copier les formules qui se trouve sur la ligne de référence (ligne 6).

Bonjour,

J'avais mal copié le code. Il fonctionne très bien mais le souci c'est qu'il m'efface tout le contenu alors que je veux au contraire copier les formules qui se trouve sur la ligne de référence (ligne 6).

Non le code recopie bien les formules ou alors on n'a pas compris.

Une chose que tu devrais faire c'est contrôler la textbox 2. D'abord on ne sait pas où se trouve la textbox à l'utilisation et si tu mets une lettre, le code va bugger.

Sinon remplace les END par "Unload UserForm1". C'est plus correct surtout si éventuellement d'autres codes devaient être exécutés. L'instruction END stoppe tous les codes.

Si ok, oublie pas de cloturer en cliquant sur le V vert.

Amicalement

En effet le code fonctionne je ne sais pas ou j'ai fait une fausse manipulation en le recopiant.

Donc merci beaucoup !!!

Rechercher des sujets similaires à "macro inserer lignes copier"