Ajout de lignes en dessous de la cellule souhaitée

Le 20/03/2017 à 11:33

Bonjour à tous

J'ai besoin de votre aide.

J'aimerai pouvoir ajouter des lignes en dessous d'une cellule souhaitée. La cellule souhaitée est sélectionnée dans un comobox.

Vous trouverez ci-joint mon fichier simplifié. Je vous explique les étapes.

  • 1/ A l'ouverture du fichier un Userform s'affiche.
  • 2/ Grace à la comobox on sélectionne le lot auquel on veut ajouter des ressources: exemple 01-Cloison
  • 3/ Lorsque l'on clique sur le commandbouton "ajouter ressources" les ressources à ajouter au lot 01-Cloison s'affichent dans une listbox. Elles correspondent à la colonne D4 de la feuil "Selection".
  • 4/ Voilà ou j'ai besoin de votre aide. J'aimerai quand cliquant sur le commandbouton "Fermer" Les ressources de la listebox s'affichent en dessous du lot 01-Cloison (Cell "A9") dans la feuil "Projet". D'où ma question comment insérer des lignes en dessous d'une cellule souhaitée.

J'ai essayé d'être le plus clair possible, n'hésitez pas à me poser des questions

Merci pour votre aide

21chiffrageces1-copie.xlsm (71.03 Ko)
Le 20/03/2017 à 22:28

Bonsoir,

Teste ceci si ça convient :

Private Sub CommandButton2_Click()

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

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

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

    If Not Cel Is Nothing Then

        For I = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(I - 1)

        Next I

    End If

    Sheets("Projet").Activate
    Unload UserForm4

End Sub
Le 21/03/2017 à 08:31

Merci beaucoup

Ton code marche parfaitement

Le 21/03/2017 à 09:48

Re

Juste une dernière question...

J'ai essayé de modifier ton code mais j'y arrive pas ://

J'aimerais que les colonnes en bleue et jaune de la feuille "Selection" correspondant aux ressources qui s'affichent dans la listbox se copient automatiquement dans la feuille projet.

Pouvez-vous encore m'aider svp

Merci pour tout

8chiffrageces1-copie.xlsm (72.67 Ko)
Le 21/03/2017 à 16:13

Bonjour,

Code de remplacement :

Private Sub CommandButton2_Click()

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

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

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

    If Not Cel Is Nothing Then

        For I = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(I - 1)
            Cel.Offset(1, 4).Value = Worksheets("Selection").Cells(I + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Selection").Cells(I + 1, 9).Value

        Next I

    End If

    Unload UserForm4
    Sheets("Projet").Activate

End Sub
Le 21/03/2017 à 16:23

Merci beaucoup pour votre aide

C'est parfait !!!!!

Le 22/03/2017 à 15:38

Bonjour Theze

J'ai juste une interrogation.

A l'ouverture du fichier ci-joint les plages de données "F9:F100", "H9:H100", "J9:J100" contiennent des formules.

Pourtant dès que l'on affecte des ressources (Grace à ton code )) sous le lot cloison, ces formules disparaissent.

J'ai regardé ton code et ne trouve pas d'explication.

Peut-être connaitrais-tu la raison ?

Merci pour toute ton aide en tout cas

11chiffrageces-formules.xlsm (164.02 Ko)
Le 22/03/2017 à 17:13

Bonjour,

Elles ne disparaissent pas, elles sont repoussées vers le bas pas l'insertion des nouvelles lignes !

Il suffit de tirer les formule vers le haut pour les entrer à nouveau. Voici le code qui le fait :

Private Sub CommandButton2_Click()

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

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

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

    If Not Cel Is Nothing Then

        For I = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1, 5).Formula = Formule
            Cel.Offset(1).Value = ListBox1.List(I - 1)
            Cel.Offset(1, 4).Value = Worksheets("Selection").Cells(I + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Selection").Cells(I + 1, 9).Value
            Cel.Offset(1, 1).Value = Worksheets("Selection").Cells(I + 1, 5).Value
            Cel.Offset(1).Font.Bold = False

        Next I

    End If

    'tire les formules vers le haut dans les cellules des lignes nouvellement créées
    Worksheets("Projet").Range("F1200").AutoFill Worksheets("Projet").Range("F1200:F9")
    Worksheets("Projet").Range("H1200").AutoFill Worksheets("Projet").Range("H1200:H9")
    Worksheets("Projet").Range("J1200").AutoFill Worksheets("Projet").Range("J1200:J9")

    Unload UserForm4
    Sheets("Projet").Activate
    Sheets("Selection").Visible = False
    Sheets("Filtre Famille").Visible = False

End Sub
Le 23/03/2017 à 08:25

Bonjour Theze,

Merci pour cette explication, et pour votre code !

Le 23/03/2017 à 16:44

ReBonjour Theze

Mon tuteur souhaite insérer une colonne désignation en début de tableau.

Cela décale donc toutes mes cellules et toutes mes références ://

La colonne 1 devient donc la colonne 2. J'ai essayé d'adapté votre code, je me suis dis que ça devait pas être sorcier. Mais il y a un beug :/ les lignes ne sont pas directement insérées sous la cellule répérée par la combobox, il y a une ligne de décalage. Et je trouve pas la solution :/

ça doit être tout bête mais j'y arrive pas!

Voici votre code que j'ai essayé d'adapté, et je vous ai joint mon fichier.

Merci de votre aide

Private Sub CommandButton2_Click()

Dim Plage As Range

Dim Cel As Range

Dim I As Integer

With Worksheets("Projet"): 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

For I = ListBox1.ListCount To 1 Step -1

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

Cel.Offset(2).Value = ListBox1.List(I - 1)

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

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

Cel.Offset(2, 1).Value = Worksheets("Selection").Cells(I + 1, 5).Value

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

Next I

End If

'tire les formules vers le haut dans les cellules des lignes nouvellement créées

' Worksheets("Projet").Range("F1200").AutoFill Worksheets("Projet").Range("F1200:F9")

'Worksheets("Projet").Range("H1200").AutoFill Worksheets("Projet").Range("H1200:H9")

'Worksheets("Projet").Range("J1200").AutoFill Worksheets("Projet").Range("J1200:J9")

Unload UserForm4

Sheets("Projet").Activate

Sheets("Selection").Visible = False

Sheets("Filtre Famille").Visible = False

End Sub

15chiffrageces-formules.xlsm (161.72 Ko)
Le 23/03/2017 à 17:59

Bonjour,

Le décalage reste le même puisque la colonne ajoutée est située à gauche de la plage. C'est juste la colonne cible qui change pour la variable "Plage" :

Private Sub CommandButton2_Click()

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

    With Worksheets("Projet"): 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

        For I = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(I - 1)
            Cel.Offset(1, 4).Value = Worksheets("Selection").Cells(I + 1, 6).Value
            Cel.Offset(1, 6).Value = Worksheets("Selection").Cells(I + 1, 9).Value
            Cel.Offset(1, 1).Value = Worksheets("Selection").Cells(I + 1, 5).Value
            Cel.Offset(1).Font.Bold = False

        Next I

    End If

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

    Unload UserForm4
    Sheets("Projet").Activate
    Sheets("Selection").Visible = False
    Sheets("Filtre Famille").Visible = False

End Sub
Le 24/03/2017 à 11:27

Ton code marche parfaitement

Il me semblait pourtant avoir testé cette solution.... j'ai du m'emmêler

Merci de m'avoir aidé

Le 27/03/2017 à 09:49

Rebonjour Theze

Saurais-tu comment conserver en même temps que les valeurs le format des cellules, dans le code que tu m'as donné ?

Merci Beaucoup pour ton aide

 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

        For i = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(i - 1)
            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, 1).Value = Worksheets("Choix").Cells(i + 1, 5).Value
            Cel.Offset(1).Font.Bold = False
        Next i

    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")
Le 27/03/2017 à 17:03

Bonjour,

Le format de quelles cellules ?

Le 28/03/2017 à 09:44

Bonjour,

J'aimerai que les cellules de la feuille "DSThéorique" prennent les valeurs de la feuille "Choix" (ça ton code gère) mais aussi le format des cellules de la feuille "Choix".

J'ai essayé de modifier le code de cette manière mais ça de fonctionne pas

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

        For i = ListBox1.ListCount To 1 Step -1

            Cel.Offset(1).EntireRow.Insert xlShiftDown, False
            Cel.Offset(1).Value = ListBox1.List(i - 1)
            Cel.Offset(1, 4).Copy
            Worksheets("Choix").Cells(i + 1, 6).PasteSpecial
            Cell.Offset(1, 6).Copy
            Worksheets("Choix").Cells(i + 1, 9).PasteSpecial
            Cell.Offset(1, 1).Copy
            Worksheets(i + 1, 5).Copy

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

    End If

Je vous rejoints le fichier

Merci pour votre aide

9chiffrageces1-formules-format.xlsm (643.20 Ko)
Le 28/03/2017 à 20:20

Bonjour,

Je ne vois pas de quel format tu parles en ce qui concerne la feuille "Choix" ! Tu veux parler des plans ?

Pour cette partie du code que tu as fais :

Sheets("Choix").Range("A2:A800").ClearContents
Sheets("Choix").Range("B2:B800").ClearContents
Sheets("Choix").Range("C2:C800").ClearContents
Sheets("Choix").Range("D2:D800").ClearContents
Sheets("Choix").Range("E2:E800").ClearContents
Sheets("Choix").Range("F2:F800").ClearContents
Sheets("Choix").Range("H2:H800").ClearContents
Sheets("Choix").Range("I2:I800").ClearContents
Sheets("Choix").Range("J2:J800").ClearContents

tu peux la remplacer pas ça :

Sheets("Choix").Range("A2:F800", "H2:J800").ClearContents
Le 29/03/2017 à 08:56

Rebonjour

Je vous ai joint une image pour être plus clair.

J'aimerais que :

- Cloison ép.50mm EI 15 Rw+C30dB

- Cloison 50mm

  • Enduit en poudre

Soit collé dans la même police (en italique) dans la feuille "DStheorique".

J'aimerais que lorsque l'on copie les colonnes de la feuille "choix" vers la feuille "DStheorique" la police et la mise en forme des cellules soient copiées aussi.

Merci pour ton aide

image10
Le 29/03/2017 à 22:08

Bonjour,

C'est bien que tu me montres une image de ta feuille Choix mais ce que serait mieux, serait que tu postes un fichier qui contienne des valeurs dans la feuille Choix car en ce qui concerne le dernier que tu à posté, la feuille Choix est vide ! Je veux bien t'aider dans la mesure de mes capacités mais je ne suis pas devin

Le 30/03/2017 à 08:59

oui c'est vrai désolé

C'est normal de rien voir dans la feuille "Choix", je m'explique ...

Lorsque l'on clique sur "ajouter un lot" l'userform4 se lance. Puis on clique sur "Ouvrir la base de données", la feuille "Filtre Famille" s'affiche et l'on coche les données que l'on souhaite copier. Quand on clique sur le bouton "sélectionner" la sélection est copiée dans la feuille "choix". Puis l'on charge et afin on ferme l'userform4.

Sauf que dans le code du bouton fermer il y a un code qui efface à chaque fois le contenue de la feuille "Choix", c'est pour ça que vous ne voyez rien.

J'ai mis ce code en commentaire donc normalement la feuille "choix" n'est plus vide et elle n'est plus masquée à l'ouverture du fichier

Je vous rejoints le fichier

Merci pour votre patience

11copie-de-chiffrageces1-formules-format1.xlsm (642.69 Ko)
Le 05/04/2017 à 10:39

Bonjour Theze,

J'ai conscience que ma demande est loin d'être simple. Je vais essayé de simplifier les choses.

Je ne souhaite plus que le texte s'affiche en normal et en italique. C'est trop compliqué avec la listbox, qui a son propre format d'écriture!

  • Cloison ép.50mm EI 15 Rw+C30dB
  • Cloison 50mm
  • Enduit en poudre

Mais est-il possible de transformer uniquement cette ligne afin de copier le format des cellules?

Cel.Offset(1, 1).Value = Worksheets("Choix").Cells(i + 1, 5).Value

Je suis bloquée sur ce problème depuis une semaine et je commence à décourager ! Pourtant j'ai quasiment fini de coder mon fichier.

Merci pour votre aide

Rechercher des sujets similaires à "ajout lignes dessous souhaitee"