Ajout de lignes en dessous de la cellule souhaitée

Bonjour,

Dans ce cas, il te suffit de récupérer le formatage de la feuille "Choix" en paramétrant les propriétés que tu souhaites :

Private Sub CommandButton2_Click()

    Dim Plage As Range
    Dim Cel As Range
    Dim I As Integer

    With Worksheets("DStheorique"): Set Plage = .Range(.Cells(9, 2), .Cells(.Rows.Count, 2).End(xlUp)): End With

    Set Cel = Plage.Find(ComboBox1.Text, , xlValues, xlWhole)

    If Not Cel Is Nothing Then

        Application.ScreenUpdating = False

        For I = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).EntireRow.Insert xlShiftDown, False

            With Cel.Offset(1)

                .Value = Worksheets("Choix").Cells(I + 1, 4).Value
                .Font.Name = Worksheets("Choix").Cells(I + 1, 4).Font.Name
                .Font.Bold = Worksheets("Choix").Cells(I + 1, 4).Font.Bold
                .Font.Italic = Worksheets("Choix").Cells(I + 1, 4).Font.Italic

            End With

            With Cel.Offset(1, 1)

                .Value = Worksheets("Choix").Cells(I + 1, 5).Value
                .Font.Name = Worksheets("Choix").Cells(I + 1, 5).Font.Name
                .Font.Bold = Worksheets("Choix").Cells(I + 1, 5).Font.Bold
                .Font.Italic = Worksheets("Choix").Cells(I + 1, 5).Font.Italic

            End With

            Cel.Offset(1, 4).Value = Worksheets("Choix").Cells(I + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Choix").Cells(I + 1, 9).Value

            Cel.Offset(1).Font.Bold = False

        Next I

        Application.ScreenUpdating = True

    End If

    'tire les formules vers le haut dans les cellules des lignes nouvellement créées
    Worksheets("DStheorique").Range("G1200").AutoFill Worksheets("DStheorique").Range("G1200:G9")
    Worksheets("DStheorique").Range("I1200").AutoFill Worksheets("DStheorique").Range("I1200:I9")
    Worksheets("DStheorique").Range("K1200").AutoFill Worksheets("DStheorique").Range("K1200:K9")

    Unload UserForm4
    Sheets("DStheorique").Activate
    'Sheets("Choix").Visible = False
    Sheets("Filtre Famille").Visible = False

    'Sheets("Choix").Range("A2:F800", "H2:J800").ClearContents

End Sub

Votre code marche parfaitement!!!

Merci pour tout, votre patience surtout...

C'est incroyable je galère depuis une semaine et hop.... vous résolvez le problème

On a l'impression que c'est simple ^^ Mais c'est loin d'être le cas

Encore merci

A+ (Mais pas de si tôt j'espère)

Comme dit le proverbe, "Il vaut mieux un qui sait que cent qui cherchent !"

Bonjour,

moi j'ai un problème par rapport à l'ajout des lignes. en effet, mon code doit lire des cellules de tableau et les ajouter à un une autre feuille selon certaines conditions, cependant, j'ai une erreur

Option Explicit

Sub LAjouterLignes()

Dim Irow, Icol As Integer

Dim DernCol, DernLig As Integer

Dim MyVar, MyRange As Range

Dim ShName As String

Dim CaB As Worksheet

Dim sh As Worksheet

Set CaB = Worksheets("Calendrier des Besoins")

DernCol = CaB.Range("A1").End(xlToRight).Column

DernLig = CaB.Range("A1").End(xlDown).Row

For Irow = 3 To DernLig

For Icol = 4 To DernCol

If CaB.Cells(Irow, Icol) = "x" Then

Set MyRange = CaB.Range(CaB.Cells(Irow, 2), CaB.Cells(Irow, 3))

ShName = "BC - " & CaB.Cells(1, Icol)

Debug.Print MyRange(1, 1) & ", " & MyRange(1, 2) & ", " & ShName

Call Initialize(ShName, MyRange)

End If

Next

Next

End Sub

Sub Initialize(ByVal ShN As String, ByRef R As Range)

Dim I, DL As Integer

Dim trouve As Boolean

trouve = False

With Sheets(ShN)

( à ce niveau ) DL = .Range("A3").End(xlDown).Row

For I = 3 To DL

If .Cells(I, 1).Value = R.Cells(1, 1).Value Then

trouve = True

End If

Next

If Not (trouve) Then

DL = DL + 1

.Cells(I, 1).Value = R.Cells(1, 1).Value

.Cells(I, 2).Value = R.Cells(1, 2).Value

End If

End With

End Sub

Merci d'avance

Bonjour,

Mais quel rapport avec ce fil ?

Theze a écrit :

Bonjour,

Mais quel rapport avec ce fil ?

Bonjour,

c'était par rapport aux ajout de ligne, mais c'est bon pour moi;

merci

Bonjour,

c'était par rapport aux ajout de ligne, mais c'est bon pour moi;

OK, désolé, je ne comprenais pas

Dans ce cas, il est bien de poster un fichier exemple avec des données non confidentielles afin de pouvoir voir le comportement de la macro dans le fichier.

Il est bien aussi d'utiliser les balises Code (bouton Code) et de coller le code entre ces deux balises !

D'accord, merci.

c'est noté