mathieu42400
XLDnaute Nouveau
Bonjour à tous,
Dans le tableau du excel ci-joint (colonne L à Q) j'aimerais faire en sorte que chaque cellule = à 0 soit remplie par la dernière cellule pleine (de la même ligne) du tableau.
Pour ce faire, j'avais pensé à un code qui copie et colle la cellule juste après dans la cellule en question, si celle-ci est = à 0. Le problème est qu'il faut lancer le programme plusieurs fois avant d'avoir le tableau avec toutes les cellules de remplies. Pour éviter de lancer plusieurs fois le programme, j'avais pensé à une boucle Do While, qui permettait de faire fonctionner le programme jusqu'à que la dernière cellule = à 0 (remplis manuellement dans le programme, en l'occurrence la cellule L525 ici) soit pleine.
Cependant, de 1, je ne sais pas si c'est la meilleure manière d'arriver à mon but, et de 2, ma boucle while ne fonctionne pas (elle n'arrête pas de tourner sans arriver à un résultat).
D'autre part, dans mon code, j'ai essayé de mettre en place des lignes de code pour optimiser la vitesse de la macro, mais je ne sais pas si c'est la meilleure manière de faire. Les conseils sur cette partie du code sont également les bienvenus.
PS : je cherche également comment trouver la dernière cellule = à 0 d'un tableau par une macro (pour éviter de modifier la macro à chaque fois que ma plage de donnée changera).
Toutes les aides et conseils sont les bienvenus. Le fichier est en pièce jointe.
Merci d'avance
voici le programme que j'ai fait :
Sub copier_case_après()
'sauvegarder le fichier avant de lancer la macro
ActiveWorkbook.Save
'procédure d'optimisation de la macro :
'1 - déclaration des variables pour les applications
Dim ecran As Boolean, barre As Boolean, boevent As Boolean, saut As Boolean
Dim calcul As Integer
'2 - affection des applications aux variables
ecran = Application.ScreenUpdating
barre = Application.DisplayStatusBar
calcul = Application.Calculation
boevent = Application.EnableEvents
saut = ActiveSheet.DisplayPageBreaks
'3 - mise en arrêt des applications
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'déclaration et affection de la plage à la variable qui définit la plage de cellule concernée
Dim selection As Range
Set selection = Range("L6:Q530")
'boucle do while pour relancer le programme tant que la cellule L525 est vide
Do While Range("L525") = 0
'boucle for parcourant chaque cellule de la selection de plage
For Each cellule In selection
'condition : si la cellule active est differente de 0, la boucle entre en marche
If cellule.Offset(0, 0).Value <> 0 Then
'condition : si la cellule d'avant est egale à 0
If cellule.Offset(0, -1) = 0 Then
'action : la cellule juste après est copiée puis collée en collage spéciale (juste en valeur)
cellule.Offset(0, 0).Copy
cellule.Offset(0, -1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
End If
Next cellule
Loop
'4 - remise en marche des applications
Application.ScreenUpdating = ecran
Application.DisplayStatusBar = barre
Application.Calculation = calcul
Application.EnableEvents = boevent
ActiveSheet.DisplayPageBreaks = saut
End Sub
Dans le tableau du excel ci-joint (colonne L à Q) j'aimerais faire en sorte que chaque cellule = à 0 soit remplie par la dernière cellule pleine (de la même ligne) du tableau.
Pour ce faire, j'avais pensé à un code qui copie et colle la cellule juste après dans la cellule en question, si celle-ci est = à 0. Le problème est qu'il faut lancer le programme plusieurs fois avant d'avoir le tableau avec toutes les cellules de remplies. Pour éviter de lancer plusieurs fois le programme, j'avais pensé à une boucle Do While, qui permettait de faire fonctionner le programme jusqu'à que la dernière cellule = à 0 (remplis manuellement dans le programme, en l'occurrence la cellule L525 ici) soit pleine.
Cependant, de 1, je ne sais pas si c'est la meilleure manière d'arriver à mon but, et de 2, ma boucle while ne fonctionne pas (elle n'arrête pas de tourner sans arriver à un résultat).
D'autre part, dans mon code, j'ai essayé de mettre en place des lignes de code pour optimiser la vitesse de la macro, mais je ne sais pas si c'est la meilleure manière de faire. Les conseils sur cette partie du code sont également les bienvenus.
PS : je cherche également comment trouver la dernière cellule = à 0 d'un tableau par une macro (pour éviter de modifier la macro à chaque fois que ma plage de donnée changera).
Toutes les aides et conseils sont les bienvenus. Le fichier est en pièce jointe.
Merci d'avance
voici le programme que j'ai fait :
Sub copier_case_après()
'sauvegarder le fichier avant de lancer la macro
ActiveWorkbook.Save
'procédure d'optimisation de la macro :
'1 - déclaration des variables pour les applications
Dim ecran As Boolean, barre As Boolean, boevent As Boolean, saut As Boolean
Dim calcul As Integer
'2 - affection des applications aux variables
ecran = Application.ScreenUpdating
barre = Application.DisplayStatusBar
calcul = Application.Calculation
boevent = Application.EnableEvents
saut = ActiveSheet.DisplayPageBreaks
'3 - mise en arrêt des applications
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
'déclaration et affection de la plage à la variable qui définit la plage de cellule concernée
Dim selection As Range
Set selection = Range("L6:Q530")
'boucle do while pour relancer le programme tant que la cellule L525 est vide
Do While Range("L525") = 0
'boucle for parcourant chaque cellule de la selection de plage
For Each cellule In selection
'condition : si la cellule active est differente de 0, la boucle entre en marche
If cellule.Offset(0, 0).Value <> 0 Then
'condition : si la cellule d'avant est egale à 0
If cellule.Offset(0, -1) = 0 Then
'action : la cellule juste après est copiée puis collée en collage spéciale (juste en valeur)
cellule.Offset(0, 0).Copy
cellule.Offset(0, -1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
End If
End If
Next cellule
Loop
'4 - remise en marche des applications
Application.ScreenUpdating = ecran
Application.DisplayStatusBar = barre
Application.Calculation = calcul
Application.EnableEvents = boevent
ActiveSheet.DisplayPageBreaks = saut
End Sub
