Insertion de lignes en fonction d'une valeur de cellule

bonjour,

j'aurai besoin d'aide pour réaliser une macro qui permet de construire un tableau avec un nombre de ligne variable (résultat d'un calcul dans une cellule)

Plutôt qu'un long discours, je vous laisse un fichier explicatif avec ce que je souhaiterai.

Merci de votre aide.

Arkheos

25arkheos.xlsx (11.54 Ko)

Bonjour,

Que doit-on faire pour la colonne A (Heure) pour un tableau variable?

Cdlt.

bonjour,

pour la colonne A, je mettrai 1, 2, 3, ect....

si c'est possible de le renseigner en même temps, ne vous gênez pas (si c'est pas trop demandé )

merci de votre aide.

Arkheos

Re,

Une proposition à étudier.

A te relire.

Cdlt.

Option Explicit

Private Sub cmdGO_Click()
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim lCol As Long, lRow As Long
Dim Num As Long, rw As Long
Dim I As Long
Dim rCell As Range

    Application.ScreenUpdating = False

    Set ws = ActiveSheet: Set lo = ws.ListObjects(1)
    Set ws2 = Worksheets("Feuil3"): Set lo2 = ws2.ListObjects(1)

    If Not lo2.DataBodyRange Is Nothing Then lo2.DataBodyRange.Delete

    With lo
        lCol = lo.ListColumns.Count
        lRow = lo.DataBodyRange.Rows.Count
        For rw = 1 To lRow
            Num = lo.DataBodyRange.Cells(rw, lCol)
            For I = 1 To Num
                If Not lo2.InsertRowRange Is Nothing Then
                    Set rCell = lo2.InsertRowRange.Cells(2)
                Else
                    Set rCell = lo2.HeaderRowRange.Cells(2).Offset(lo2.ListRows.Count + 1)
                End If
                lo.DataBodyRange.Cells(rw, 1).Offset(0, 1).Resize(1, 4).Copy
                rCell.PasteSpecial xlPasteValues
                Application.CutCopyMode = False
            Next I
        Next rw
    End With

    Set rCell = Nothing
    Set lo2 = Nothing: Set lo = Nothing
    Set ws2 = Nothing: Set ws = Nothing

End Sub

Bonjour Jean Eric,

tout d'abord, merci pour ton aide.

Ton code est impressionnant ! je n'y comprends rien, normal je suis débutant dans le codage ....

Je n'ai pas réussi à faire fonctionner la macro (en cliquant sur le bouton GO ou en faisant f5 dans la macro directement) ?

c'est peut être excel 2016 (que j'utilise) qui fait des sienne ???

J'ai une question : si je copie ton code et que je le colle dans mon fichier définitif, tu penses que ça fonctionnera ?

Merci de ta patience.

Cordialement

Arkheos

Bonjour,

la procédure de mon fichier fonctionne t'elle?

Cdlt.

Re,

Je n'ai pas testé avec ta procédure.

J'essaie dès que je le pourrais et je te dirais.

Re,

j'ai copier/coller le code que tu as mis dans ta réponse, et ça ne fonctionne pas

voilà ce que ça donne :

Option Explicit

Private Sub cmdGO_Click()

Dim ws As Worksheet, ws2 As Worksheet

Dim lo As ListObject, lo2 As ListObject

Dim lCol As Long, lRow As Long

Dim Num As Long, rw As Long

Dim I As Long

Dim rCell As Range

Application.ScreenUpdating = False

Set ws = ActiveSheet: Set lo = ws.ListObjects(1)

Set ws2 = Worksheets("Feuil3"): Set lo2 = ws2.ListObjects(1)

If Not lo2.DataBodyRange Is Nothing Then lo2.DataBodyRange.Delete

With lo

lCol = lo.ListColumns.Count

lRow = lo.DataBodyRange.Rows.Count

For rw = 1 To lRow

Num = lo.DataBodyRange.Cells(rw, lCol)

For I = 1 To Num

If Not lo2.InsertRowRange Is Nothing Then

Set rCell = lo2.InsertRowRange.Cells(2)

Else

Set rCell = lo2.HeaderRowRange.Cells(2).Offset(lo2.ListRows.Count + 1)

End If

lo.DataBodyRange.Cells(rw, 1).Offset(0, 1).Resize(1, 4).Copy

rCell.PasteSpecial xlPasteValues

Application.CutCopyMode = False

Next I

Next rw

End With

Set rCell = Nothing

Set lo2 = Nothing: Set lo = Nothing

Set ws2 = Nothing: Set ws = Nothing

End Sub

voilà merci pour ton aide.

cdlt

Arkheos

re,

si cela peut t'aider,

je souhaiterai que ton code s’insère dans le début du mien (modestement !)

Private Sub CommandButton1_Click()

 With Sheets("TdM")
.Range("B3").Value = TextBox1.Value
.Range("G3").Value = TextBox5.Value
End With

 TextBox5.Value = ""
 TextBox1.Value = ""

TextBox1.SetFocus

Unload Me

End Sub
 Private Sub CommandButton4_Click()
Unload UserForm4
End Sub

Private Sub UserForm_Click()

End Sub

ce que je souhaite, c'est que lorsque je clique sur "valider" de mon userform, la macro renseigne "num" et "Nb" du tableau, ces valeurs servent pour calculer les autres valeurs des cellules et que le tableau "final" soit créé et renseigné par ces valeurs.

j'essaie d'être le plus clair possible mais c'est pas évident !

Merci

Arkheos

RE,

En réponse de ton message et la partie surlignée, cela signifie que tu n'as pas de tableau (Excel 2007+) en Feuil3.

Pour l'autre question, c'est un autre sujet.

Cdlt.

Milles excuses !!!!

je suis un âne, ton code fonctionne parfaitement !!!!

il fallait regarder dans l'onglet 3 le résultat !!!!!

si je peux me permettre, serait il possible que le résultat ce fasse sur la même feuille ?

Merci pour ton aide

Arkheos

Re,

Une nouvelle proposition.

Cdlt.

Merci pour cette proposition,

je vais être exigent mais est il possible d'avoir le tableau en B12 ? j'ai essayé de le déplacer (copier/coller) mais ça ne marche pas.

Autre remarque : la colonne "heure" commence à 3 ?

Croix tu que je puisse mettre ton code dans le mien ?

Super boulot, merci pour ton investissement. Je n'y serais jamais arrivé seul.

Cdlt

Arkheos

Re,

J'ai modifié la formule pour le numéro d'index. mais c'est une chose que tu aurais pu faire par toi même.

Pour le tableau en B12, ce n'est pas judicieux car ton tableau de données est supposé variable.

Cdlt.

Bonjour,

merci pour la modif

je vais essayer de mettre ton code dans le mien pour voir si ça peut fonctionner.

Un grand merci pour ton aide.

Cdlt

Arkheos

Rechercher des sujets similaires à "insertion lignes fonction valeur"