Création de ligne automatiques AVEC contenu

Bonjour,

Je souhaiterais créer de nouvelles lignes à mon tableau avec un contenu texte spécifique sur certaines colonnes.

Mon tableau contient 11 colonnes et 19 nouvelles lignes sont créées à l'aide d'un bouton lié à une macro trouvée en ligne et que j'ai uniquement légèrement modifié (cf code ci-dessous). Je souhaiterais désormais que les 5 premières colonnes de ces 19 nouvelles lignes contiennent un texte spécifique et propre à chaque ligne, pour pouvoir réitérer l'action chaque mois.

Pour information, seule le contenu de la colonne "mois" doit changer à l'ajout de nouvelles lignes, en mettant le mois M+1 par rapport au mois actuel, sinon les 4 autres colonnes ("Infos 1" à "Infos 4") se répètent dans l'ordre indiqué sur l'image à chaque clic sur le bouton.

Auriez-vous la solution, svp ?

1 2

Code VBA actuel :

Option Explicit
Sub AjouterUneLigne()
    AjouterNLignes loData, 1, 1
    GoToDerniereLigneDuTableau loData, 10
End Sub
Sub Ajout_lignes_nouveau_mois()
    AjouterNLignes loData, 19, 1
End Sub
Private Sub GoToDerniereLigneDuTableau(loTable As ListObject, nLignesVisibles As Long)
    Dim rLastCell As Range
    Set rLastCell = loTable.DataBodyRange.Resize(1, 1).Offset(loTable.DataBodyRange.Rows.Count - 1)
    On Error Resume Next 'au cas ou on est en haut de la feuille
    Application.Goto rLastCell.Offset(-nLignesVisibles, 1), True
    On Error GoTo 0
    Application.Goto rLastCell, False
End Sub
Private Sub AjouterNLignes(loTable As ListObject, nRow As Long, lColKey As Long)
    'on aurait pu faire une boucle ajoutant nRow lignes,
    'mais le redimensionnement - resize - est (beaucoup) plus rapide que l'ajout
    'd'une ligne à la suite.
    Dim lMax As Long
    Dim lNbRowsStart As Long
    'aucune donnee, on demarre la numerotation a 1
    If loTable.DataBodyRange Is Nothing Then
        loTable.ListRows.Add (1)
        If nRow <> 1 Then loTable.Resize loTable.Range.Resize(loTable.Range.Rows.Count + nRow - 1)
        loTable.DataBodyRange.Resize(, 1).Offset(, lColKey - 1).Value = _
            fctSequence(nRow, 1, 1, 1)
            'Application.WorksheetFunction.Sequence(nRow, 1)'unqiuement en excel 365
    Else
        lNbRowsStart = loTable.DataBodyRange.Rows.Count
        lMax = Application.WorksheetFunction.Max(loTable.DataBodyRange.Columns(lColKey))
        loTable.Resize loTable.Range.Resize(loTable.Range.Rows.Count + nRow)
        loTable.DataBodyRange.Resize(nRow, 1).Offset(lNbRowsStart, lColKey - 1).Value = _
            fctSequence(nRow, 1, lMax + 1, 1)
        'Application.WorksheetFunction.Sequence(nRow, 1, lMax + 1) 'si vous etes en excel 365
    End If
End Sub
Private Function fctSequence(lRow As Long, lCol As Long, lStart As Long, lStep As Long)
    Dim arrSequence As Variant
    ReDim arrSequence(1 To lRow, 1 To lCol) As Variant
    Dim lRowLoop As Long, lColLoop As Long
    Dim lValue As Long
    lValue = lStart
    For lRowLoop = 1 To lRow
        For lColLoop = 1 To lCol
            arrSequence(lRowLoop, lColLoop) = lValue
            lValue = lValue + lStep
        Next
    Next
    fctSequence = arrSequence
End Function
Private Function loData() As ListObject
    'Set loData = wksData.ListObjects("T_Data") 'au cas où l'on veut faire fonctionner la macro a partir d'une autre feuille
    Set loData = ActiveSheet.ListObjects(1)
End Function

Merci beaucoup

Bonsoir,

auriez vous le fichier qui va avec les images ? Sinon on peut partir d'une feuille vierge mais c'est dommage...

Mon idée sinon c'est de placer les données des 19 lignes sur une feuille sous une forme de tableau, puis une fois les 19 lignes vierges créées il suffira de copier ces données sous forme de tableau sur le tableau à partir de la première cellule vide de la colonne G, voir de la colonne F qui sur la feuille "système" pourrait contenir une formule répétitive, comme cela on identifie le mois année sur la première cellule, la formule la propage sur les 19 lignes et ensuite on copie colle les données des 19 lignes et 5 colonnes.

@ bientôt

LouReeD

Rechercher des sujets similaires à "creation ligne automatiques contenu"