Recopier formule jusqu'a dernière ligne du tableau
Nanou3868 Messages postés 12 Date d'inscription Statut Membre Dernière intervention -
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
- Xselect premier column
- Tableau word - Guide
- Formule si et - Guide
- Tableau ascii - Guide
- Formule somme excel ligne - Guide
- Retour à la ligne excel formule - Guide
4 réponses
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
Je crois qu’avec l’aide de chacun je suis arrivé à quelque chose de pas trop mal et je vous remercie tous…
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
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
Merci beaucoup Bruno pour le temps consacré à m’aider dans ces dures, lignes d’écriture en VBA.