Recopier formule jusqu'a dernière ligne du tableau

Nanou3868 Messages postés 12 Statut Membre -  
Nanou3868 Messages postés 12 Statut Membre -

Bonjour,

J’ai plusieurs formules dans mon tableau Excel que je souhaite recopier automatiquement jusqu’à la dernière ligne contenant des données. Pour contourner ce problème, j’ai étendu manuellement les formules sur un grand nombre de lignes, afin que ma macro prenne en compte tous les cas possibles, puisque le nombre de lignes varie chaque jour. Cependant, cette méthode n’est pas très propre, car elle génère de nombreuses lignes affichant l’erreur #VALEUR! lorsqu’il n’y a plus de données.

Je cherche donc une solution plus efficace et dynamique pour étendre mes formules uniquement jusqu’à la dernière ligne utile.

Sub DEPENSE_REGLMT()
'
' DEPENSE_REGLMT Macro
' Maj de l'extraction, ajout formule (cpte & date) pour TD
'

'
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "Date Mandat"
    Range("E3").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    Columns("V:V").Select
    Selection.Cut
    Columns("F:F").Select
    Selection.Insert Shift:=xlToRight
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "Cpte Hors Lettre"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = "=+RIGHT(RC[-1],LEN(RC[-1])-1)"
    Range("H2").Select
    Selection.AutoFill Destination:=Range("H2:H12370")
    Range("H2:H12370").Select
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 55
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 91
    ActiveWindow.ScrollRow = 109
    ActiveWindow.ScrollRow = 217
    ActiveWindow.ScrollRow = 271
    ActiveWindow.ScrollRow = 487
    ActiveWindow.ScrollRow = 541
    ActiveWindow.ScrollRow = 757
    ActiveWindow.ScrollRow = 793
    ActiveWindow.ScrollRow = 1603
    ActiveWindow.ScrollRow = 1873
    ActiveWindow.ScrollRow = 2071
    ActiveWindow.ScrollRow = 2377
    ActiveWindow.ScrollRow = 2486
    ActiveWindow.ScrollRow = 2684
    ActiveWindow.ScrollRow = 2720
    ActiveWindow.ScrollRow = 2882
    ActiveWindow.ScrollRow = 2936
    ActiveWindow.ScrollRow = 3080
    ActiveWindow.ScrollRow = 3098
    ActiveWindow.ScrollRow = 3134
    ActiveWindow.ScrollRow = 3152
    ActiveWindow.ScrollRow = 3188
    ActiveWindow.ScrollRow = 3494
    ActiveWindow.ScrollRow = 3602
    ActiveWindow.ScrollRow = 3638
    ActiveWindow.ScrollRow = 3710
    ActiveWindow.ScrollRow = 3728
    ActiveWindow.ScrollRow = 3710
    ActiveWindow.ScrollRow = 3674
    ActiveWindow.ScrollRow = 3602
    ActiveWindow.ScrollRow = 3548
    ActiveWindow.ScrollRow = 3404
    ActiveWindow.ScrollRow = 3350
    ActiveWindow.ScrollRow = 3224
    ActiveWindow.ScrollRow = 3188
    ActiveWindow.ScrollRow = 3170
    ActiveWindow.ScrollRow = 3152
    ActiveWindow.ScrollRow = 3170
    ActiveWindow.ScrollRow = 3188
    ActiveWindow.ScrollRow = 3206
    ActiveWindow.ScrollRow = 3242
    ActiveWindow.ScrollRow = 3278
    ActiveWindow.ScrollRow = 3368
    ActiveWindow.ScrollRow = 3404
    ActiveWindow.ScrollRow = 3512
    ActiveWindow.ScrollRow = 3566
    ActiveWindow.ScrollRow = 3674
    ActiveWindow.ScrollRow = 3728
    ActiveWindow.ScrollRow = 3818
    ActiveWindow.ScrollRow = 3854
    ActiveWindow.ScrollRow = 3872
    ActiveWindow.ScrollRow = 3890
    ActiveWindow.ScrollRow = 3926
    ActiveWindow.ScrollRow = 3944
    ActiveWindow.ScrollRow = 3980
    ActiveWindow.ScrollRow = 3998
    ActiveWindow.ScrollRow = 4016
    ActiveWindow.ScrollRow = 4034
    ActiveWindow.ScrollRow = 4052
    ActiveWindow.ScrollRow = 4070
    ActiveWindow.ScrollRow = 4088
    ActiveWindow.ScrollRow = 4106
    ActiveWindow.ScrollRow = 4124
    ActiveWindow.ScrollRow = 4142
    ActiveWindow.ScrollRow = 4160
    ActiveWindow.ScrollRow = 4178
    ActiveWindow.ScrollRow = 4196
    ActiveWindow.ScrollRow = 4214
    ActiveWindow.ScrollRow = 4232
    ActiveWindow.ScrollRow = 4250
    ActiveWindow.ScrollRow = 4268
    ActiveWindow.ScrollRow = 4286
    ActiveWindow.ScrollRow = 4304
    ActiveWindow.ScrollRow = 4322
    ActiveWindow.ScrollRow = 4340
    ActiveWindow.ScrollRow = 4358
    ActiveWindow.ScrollRow = 4376
    ActiveWindow.ScrollRow = 4394
    ActiveWindow.ScrollRow = 4412
    ActiveWindow.ScrollRow = 4413
    ActiveWindow.SmallScroll Down:=222
      ActiveWindow.SmallScroll Down:=-18
    Range("H12320").Select
    Selection.AutoFill Destination:=Range("H12320:H14000"), Type:=xlFillDefault
    Range("H12320:H14000").Select
    ActiveWindow.ScrollRow = 13976
    ActiveWindow.ScrollRow = 13956
    ActiveWindow.ScrollRow = 13935
    ActiveWindow.ScrollRow = 13874
    ActiveWindow.ScrollRow = 13833
    ActiveWindow.ScrollRow = 13772
    ActiveWindow.ScrollRow = 13690
    ActiveWindow.ScrollRow = 13567
    ActiveWindow.ScrollRow = 12178
    ActiveWindow.ScrollRow = 11912
    ActiveWindow.ScrollRow = 10421
    ActiveWindow.ScrollRow = 9685
    ActiveWindow.ScrollRow = 7949
    ActiveWindow.ScrollRow = 7029
    ActiveWindow.ScrollRow = 5190
    ActiveWindow.ScrollRow = 4414
    ActiveWindow.ScrollRow = 2861
    ActiveWindow.ScrollRow = 2575
    ActiveWindow.ScrollRow = 1308
    ActiveWindow.ScrollRow = 1083
    ActiveWindow.ScrollRow = 470
    ActiveWindow.ScrollRow = 287
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 1
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "Cpte 3 Chiffres"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=+VALUE(LEFT(RC[-1],3))"
    Range("I2").Select
    Selection.AutoFill Destination:=Range("I2:I14000")
    Range("I2:I14000").Select
    Columns("J:J").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "Types Dépenses"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=+VLOOKUP(RC[-1],table!R2C1:R74C2,2,TRUE)"
    Range("J2").Select
    Selection.AutoFill Destination:=Range("J2:J14000")
    Range("J2:J14000").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Columns("P:P").EntireColumn.AutoFit
    Columns("P:P").ColumnWidth = 30.57
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "Calcul DLP"
    Range("Q2").Select
    ActiveCell.FormulaR1C1 = _
        "=+DATEVALUE(MID(RC[-1],SEARCH(""??/??/????"",RC[-1]),10))"
    Range("Q2").Select
    Selection.NumberFormat = "m/d/yyyy"
    Selection.AutoFill Destination:=Range("Q2:Q14000")
    Range("Q2:Q14000").Select
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "Mois DLP"
    Range("R2").Select
    ActiveCell.FormulaR1C1 = "=+MONTH(RC[-1])"
    Range("R2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.AutoFill Destination:=Range("R2:R14000")
    Range("R2:R14000").Select
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    Columns("X:X").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("X1").Select
    ActiveCell.FormulaR1C1 = "Date de Règlement"
    Range("X2").Select
    ActiveCell.FormulaR1C1 = _
        "=+IF(RC[-1]="""",""NC"",DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2)))"
    Range("X2").Select
    Selection.NumberFormat = "m/d/yyyy"
    Selection.AutoFill Destination:=Range("X2:X14000")
    Range("X2:X14000").Select
    Rows("1:1").Select
    Range("I1").Activate
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("A1").Select
End Sub


Windows / Firefox 140.0

A voir également:

4 réponses

Réponse 1 / 4
Bruno83200_6929 Messages postés 655 Date d'inscription   Statut Membre Dernière intervention   156
 

Bonjour,

Pour rendre votre macro plus dynamique et éviter de copier les formules sur un nombre fixe de lignes (ce qui génère des erreurs #VALEUR!), vous pouvez déterminer dynamiquement la dernière ligne contenant des données dans une colonne de référence, puis appliquer les formules uniquement jusqu'à cette ligne. Voici comment optimiser votre macro :

Sub DEPENSE_REGLMT()
    ' Macro optimisée pour appliquer les formules dynamiquement jusqu'à la dernière ligne

    Dim ws As Worksheet
    Dim lastRow As Long

    ' Définir la feuille active
    Set ws = ActiveSheet

    ' Trouver la dernière ligne non vide dans une colonne de référence (par exemple, colonne G)
    lastRow = ws.Cells(Rows.Count, "G").End(xlUp).Row

    ' Ajouter les en-têtes
    ws.Range("D1").Value = "Date Mandat"
    ws.Range("H1").Value = "Cpte Hors Lettre"
    ws.Range("I1").Value = "Cpte 3 Chiffres"
    ws.Range("J1").Value = "Types Dépenses"
    ws.Range("Q1").Value = "Calcul DLP"
    ws.Range("R1").Value = "Mois DLP"
    ws.Range("X1").Value = "Date de Règlement"

    ' Déplacer la colonne V vers F
    ws.Columns("V").Cut
    ws.Columns("F").Insert Shift:=xlToRight

    ' Insérer les colonnes I, J, Q, R, X
    ws.Columns("I").Insert Shift:=xlToRight
    ws.Columns("J").Insert Shift:=xlToRight
    ws.Columns("Q").Insert Shift:=xlToRight
    ws.Columns("Q").Insert Shift:=xlToRight
    ws.Columns("X").Insert Shift:=xlToRight

    ' Ajuster la largeur de la colonne P
    ws.Columns("P").AutoFit
    ws.Columns("P").ColumnWidth = 30.57

    ' Appliquer les formules dynamiquement jusqu'à la dernière ligne
    ws.Range("H2:H" & lastRow).FormulaR1C1 = "=RIGHT(RC[-1],LEN(RC[-1])-1)"
    ws.Range("I2:I" & lastRow).FormulaR1C1 = "=VALUE(LEFT(RC[-1],3))"
    ws.Range("J2:J" & lastRow).FormulaR1C1 = "=VLOOKUP(RC[-1],table!R2C1:R74C2,2,TRUE)"
    ws.Range("Q2:Q" & lastRow).FormulaR1C1 = "=DATEVALUE(MID(RC[-1],SEARCH(""??/??/????"",RC[-1]),10))"
    ws.Range("Q2:Q" & lastRow).NumberFormat = "m/d/yyyy"
    ws.Range("R2:R" & lastRow).FormulaR1C1 = "=MONTH(RC[-1])"
    ws.Range("R2:R" & lastRow).HorizontalAlignment = xlCenter
    ws.Range("X2:X" & lastRow).FormulaR1C1 = "=IF(RC[-1]="""",""NC"",DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2)))"
    ws.Range("X2:X" & lastRow).NumberFormat = "m/d/yyyy"

    ' Formater la première ligne (en-têtes)
    With ws.Rows(1)
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With

    ' Sélectionner A1 pour revenir au début
    ws.Range("A1").Select
End Sub
1
Nanou3868 Messages postés 12 Statut Membre 3
 

Merci beaucoup Bruno pour le temps consacré à m’aider dans ces dures, lignes d’écriture en VBA. 

1
Réponse 2 / 4
Nanou3868 Messages postés 12 Statut Membre 3
 

Je crois qu’avec l’aide de chacun je suis arrivé à quelque chose de pas trop mal et je vous remercie tous… 
1
Réponse 3 / 4
JCB40 Messages postés 3465 Date d'inscription   Statut Membre Dernière intervention   469
 

Bonjour

Code a tester:

Sub DEPENSE_REGLMT()
    ' DEPENSE_REGLMT Macro
    ' Maj de l'extraction, ajout formule (cpte & date) pour TD

    ' Ajout des en-têtes
    Range("D1").Value = "Date Mandat"
    Range("H1").Value = "Cpte Hors Lettre"
    Range("I1").Value = "Cpte 3 Chiffres"
    Range("J1").Value = "Types Dépenses"
    Range("Q1").Value = "Calcul DLP"
    Range("R1").Value = "Mois DLP"
    Range("X1").Value = "Date de Règlement"

    ' Déplacement de la colonne V à F
    Columns("V:V").Cut Destination:=Columns("F:F")

    ' Formules pour Cpte Hors Lettre
    Range("H2").FormulaR1C1 = "=RIGHT(RC[-1],LEN(RC[-1])-1)"
    Range("H2:H12370").FillDown

    ' Formules pour Cpte 3 Chiffres
    Range("I2").FormulaR1C1 = "=VALUE(LEFT(RC[-1],3))"
    Range("I2:I14000").FillDown

    ' Formules pour Types Dépenses
    Range("J2").FormulaR1C1 = "=VLOOKUP(RC[-1],table!R2C1:R74C2,2,TRUE)"
    Range("J2:J14000").FillDown

    ' Formules pour Calcul DLP
    Range("Q2").FormulaR1C1 = "=DATEVALUE(MID(RC[-1],SEARCH(""??/??/????"",RC[-1]),10))"
    Range("Q2:Q14000").NumberFormat = "m/d/yyyy"
    Range("Q2:Q14000").FillDown

    ' Formules pour Mois DLP
    Range("R2").FormulaR1C1 = "=MONTH(RC[-1])"
    Range("R2:R14000").FillDown

    ' Formules pour Date de Règlement
    Range("X2").FormulaR1C1 = "=IF(RC[-1]="""",""NC"",DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2)))"
    Range("X2:X14000").NumberFormat = "m/d/yyyy"
    Range("X2:X14000").FillDown

    ' Ajustement de la largeur de la colonne P
    Columns("P:P").AutoFit
    Columns("P:P").ColumnWidth = 30.57

    ' Retour à la cellule A1
    Range("A1").Select
End Sub
0
Nanou3868 Messages postés 12 Statut Membre 3
 

Super ! Merci beaucoup de l'aide.. cela ma grandement inspirée car je suis carrément novice en VBA.

J'ai fais quelques modifications afin qu'elle s'adapte à mon fichier et mieux comprendre.

Pour améliorer cette macro, est-il possible d’écrire une macro VBA qui, au lieu de recopier les formules jusqu’à une ligne définie à l’avance (ex. ligne "14 000"), étend automatiquement les formules jusqu’à la dernière ligne non vide de la colonne B.

Autrement dit : la macro devrait détecter la dernière ligne remplie dans la colonne B, et recopier les formules dans les autres colonnes uniquement jusqu’à cette ligne.

Sub Mdt_Reglement()
'
' Mdt_Reglement Macro
'

    ' Ajout des en-têtes
    Range("D1").Value = "Date Mandat"
    
      
    Range("G1").Value = "Cpte Hors Lettre"
    
        ' Formules pour Cpte Hors Lettre
    Range("G2").FormulaR1C1 = "=RIGHT(RC[-1],LEN(RC[-1])-1)"
    Range("G2:G12370").FillDown
    
        ' Inseré colonne en H
    Columns("H:H").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("H6").Select
    
    Range("H1").Value = "Cpte 3 Chiffres"
    
        ' Formules pour Cpte 3 Chiffres
    Range("H2").FormulaR1C1 = "=VALUE(LEFT(RC[-1],3))"
    Range("H2:H14000").FillDown
    
       ' Inseré colonne en I
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("I6").Select
        
    Range("I1").Value = "Types Dépenses"
    
    ' Formules pour Types Dépenses
    Range("I2").FormulaR1C1 = "=VLOOKUP(RC[-1],table!R2C1:R74C2,2,TRUE)"
    Range("I2:I14000").FillDown
    
           ' Inseré colonne en P
    Columns("P:P").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("P6").Select
    
    Range("P1").Value = "Calcul DLP"
    
      ' Formules pour Calcul DLP
    Range("P2").FormulaR1C1 = "=DATEVALUE(MID(RC[-1],SEARCH(""??/??/????"",RC[-1]),10))"
    Range("P2:P14000").NumberFormat = "m/d/yyyy"
    Range("P2:P14000").FillDown
       
  ' Inseré colonne en Q
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("Q6").Select
    
    Range("Q1").Value = "Mois DLP"
    
       ' Formules pour Mois DLP
    Range("Q2").FormulaR1C1 = "=MONTH(RC[-1])"
    Range("Q2:Q14000").FillDown
    
        ' Mise en forme colonne Q mode standat
      Columns("Q:Q").Select
    Selection.NumberFormat = "General"
    With Selection
        .HorizontalAlignment = xlGeneral
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    ' Inseré colonne en w
    Columns("w:w").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("w6").Select
    
    Range("w1").Value = "Date de Règlement"
 
     ' Formules pour Date de Règlement
    Range("w2").FormulaR1C1 = "=IF(RC[-1]="""",""NC"",DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),MID(RC[-1],7,2)))"
    Range("w2:w14000").NumberFormat = "m/d/yyyy"
    Range("w2:w14000").FillDown

    ' Ajustement de la largeur de la colonne N
    Columns("o:o").AutoFit
    Columns("o:o").ColumnWidth = 30.57

    ' Renvoyer a la ligue le ligne des entetes
     With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
End Sub

1
Réponse 4 / 4
DjiDji59430 Messages postés 4331 Date d'inscription   Statut Membre Dernière intervention   703
 

Bonjour à tous,

Il n'y besoin de rien si tu utilises un tableau structuré. Il s'adapte avec les formules quand tu ajoutes une ligne (ou 2 !). Et si des formules font references a des colonnes, elle s'adaptent...


Crdlmt
0