Optimisation Macro
antoinelm
Messages postés
4
Statut
Membre
-
Le Pingou Messages postés 12274 Date d'inscription Statut Contributeur Dernière intervention -
Le Pingou Messages postés 12274 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Je souhaite optimiser le code suivant qui a pour but d'ajouter une ligne et des informations sur cette ligne en cas de présence d'une cellule non vide dans la colonne 19 suite au copier-coller d'un autre fichier Excel.
Merci donc de m'aider à l'optimiser :
Sub insère_ligne1()
Dim lig As Long
Application.ScreenUpdating = False
For lig = ActiveSheet.Cells(Columns(9).Cells.Count, 9).End(xlUp).Row To 4 Step -1
If Not IsEmpty(Cells(lig, 19)) Then
Rows(lig + 1).Insert
Rows(lig + 1).Interior.Color = RGB(191, 191, 191)
Cells(lig + 1, 1).FormulaR1C1 = Cells(lig, 1).FormulaR1C1
Cells(lig + 1, 5).FormulaR1C1 = Cells(lig, 5).FormulaR1C1
Cells(lig + 1, 12).Value = Cells(lig, 19).Value
Sheets("Date Rétroplanning").Rows(lig - 1).Insert
For i = 37 To 42
Cells(lig + 1, i).FormulaR1C1 = Cells(lig, i).FormulaR1C1
Next i
For i = 1 To 50
Sheets("Date Rétroplanning").Cells(lig - 1, i).FormulaR1C1 = Sheets("Date Rétroplanning").Cells(lig - 2, i).FormulaR1C1
Next i
Cells(lig + 1, 12).Value = Cells(lig, 19).Value
For i = 2 To 4
Cells(lig + 1, i).Value = Cells(lig, i).Value
Next i
For i = 9 To 11
Cells(lig + 1, i).Value = Cells(lig, i).Value
Next i
For i = 20 To 21
Cells(lig + 1, i).Value = Cells(lig, i).Value
Next i
Cells(lig + 1, 36).Value = Cells(lig, 36).Value
Cells(lig, 19).ClearContents
End If
Next lig
End Sub
De plus,j'aimerais enregistrer la date de copier coller d'informations dans une cellule suite au copier-coller effectué. J'ai le code suivant mais celui-ci est valide en cas de modification de cellule, ce qui n'inclut pas les copier-coller :
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column = 16 Then Target.Offset(0, 31).Value = Date
End Sub
Je reste à votre disposition pour tout complément d'informations.
En vous remerciant pour votre aide.
Antoine
Je souhaite optimiser le code suivant qui a pour but d'ajouter une ligne et des informations sur cette ligne en cas de présence d'une cellule non vide dans la colonne 19 suite au copier-coller d'un autre fichier Excel.
Merci donc de m'aider à l'optimiser :
Sub insère_ligne1()
Dim lig As Long
Application.ScreenUpdating = False
For lig = ActiveSheet.Cells(Columns(9).Cells.Count, 9).End(xlUp).Row To 4 Step -1
If Not IsEmpty(Cells(lig, 19)) Then
Rows(lig + 1).Insert
Rows(lig + 1).Interior.Color = RGB(191, 191, 191)
Cells(lig + 1, 1).FormulaR1C1 = Cells(lig, 1).FormulaR1C1
Cells(lig + 1, 5).FormulaR1C1 = Cells(lig, 5).FormulaR1C1
Cells(lig + 1, 12).Value = Cells(lig, 19).Value
Sheets("Date Rétroplanning").Rows(lig - 1).Insert
For i = 37 To 42
Cells(lig + 1, i).FormulaR1C1 = Cells(lig, i).FormulaR1C1
Next i
For i = 1 To 50
Sheets("Date Rétroplanning").Cells(lig - 1, i).FormulaR1C1 = Sheets("Date Rétroplanning").Cells(lig - 2, i).FormulaR1C1
Next i
Cells(lig + 1, 12).Value = Cells(lig, 19).Value
For i = 2 To 4
Cells(lig + 1, i).Value = Cells(lig, i).Value
Next i
For i = 9 To 11
Cells(lig + 1, i).Value = Cells(lig, i).Value
Next i
For i = 20 To 21
Cells(lig + 1, i).Value = Cells(lig, i).Value
Next i
Cells(lig + 1, 36).Value = Cells(lig, 36).Value
Cells(lig, 19).ClearContents
End If
Next lig
End Sub
De plus,j'aimerais enregistrer la date de copier coller d'informations dans une cellule suite au copier-coller effectué. J'ai le code suivant mais celui-ci est valide en cas de modification de cellule, ce qui n'inclut pas les copier-coller :
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Target.Column = 16 Then Target.Offset(0, 31).Value = Date
End Sub
Je reste à votre disposition pour tout complément d'informations.
En vous remerciant pour votre aide.
Antoine
4 réponses
-
Bonjour,
Eh bien, la procédure est optimale puisqu'aucune base n'est présente comme point de référence ..... ?
Eventuellement insérer l'instruction qui suit avant la fin de la procédure :Application.ScreenUpdating = True
Désolé.
Salutations.
Le Pingou -
Bonjour,
Tu peux remplacer tes boucles :For i = 37 To 42 Cells(lig + 1, i).FormulaR1C1 = Cells(lig, i).FormulaR1C1 Next i
par :Cells(lig + 1, 37).resize(,6).FormulaR1C1 = Cells(lig, i).FormulaR1C1
eric
edit :
celui-ci est valide en cas de modification de cellule, ce qui n'inclut pas les copier-coller
Normalement un collé génère bien un évènement Change.
En essayant continuellement, on finit par réussir.
Donc plus ça rate, plus on a de chances que ça marche.(les Shadoks)
En plus du merci (si si, ça se fait !!!), penser à mettre en résolu. Merci -
Bonjour,
Merci pour vos réponses mais cela génère une erreur 1004 liée à la dépendance du i...
En ce qui concerne l'évènement change, mon copier-coller affectant une plage de cellules et pas seulement une cellule, il est impossible d'enregistrer les dates avec ce code. Merci de m'indiquer une autre solution.
Cordialement -
Bonjour,
Vous apportez une petite correction à la proposition de eriiic (salutations) et ce sera bon.
La ligne doit être :Cells(lig + 1, 37).Resize(, 6).FormulaR1C1 = Cells(lig, 37).Resize(, 6).FormulaR1C1
Concernant la suite je vous répète ceci:
Eh bien, la procédure est optimale puisqu'aucune base n'est présente comme point de référence ..... ?
