Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'u n
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'u n
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'u n
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Bonjour,
Manque le début et la fin , si le pb est sensé venir du code!
Cordialement
--
lSteph
On 21 oct, 14:19, LANIMAL wrote:Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Bonjour,
Manque le début et la fin , si le pb est sensé venir du code!
Cordialement
--
lSteph
On 21 oct, 14:19, LANIMAL <nore...@xxx.yy> wrote:
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Bonjour,
Manque le début et la fin , si le pb est sensé venir du code!
Cordialement
--
lSteph
On 21 oct, 14:19, LANIMAL wrote:Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci de ton attention,
Voilà, je te mets tout.
La suppression des dr est quasi instantanée,
Ce sont les écritures et Copier-Coller qui sont lents.
Il y a des formules dépendantes dans d'autres feuilles,
peut-être est-ce la cause.
J'ai essayé : " Application.Calculation = False "
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci
Sub Reformat_Réunica()
If Selection.Columns.Count <> 5 Then Exit Sub
PremLigne = Selection.Row
DerLign = Range("A20000").End(xlUp).Row
For Each dr In ActiveSheet.Shapes 'Ajouter +1 à Derlign car le
dernier objet a le pied dans Derlign+1
If Not Intersect(dr.TopLeftCell, Range("A" & PremLigne & ":H" &
DerLign + 1)) Is Nothing _
And Not Intersect(dr.BottomRightCell, Range("A" & PremLigne & ":H"
& DerLign + 1)) Is Nothing Then dr.Delete
Next
'====Re-écriture du tableau
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1 & ":C" & PremLigne + 1).NumberFormat =
"dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
Range("A" & PremLigne + 1 & ":A" & PremLigne + 2).HorizontalAlignment
= xlRight
'====Suppression 11 lignes devenues inutiles
Rows(PremLigne + 3 & ":" & PremLigne + 13).Select
Selection.Delete
DerLign = Range("A20000").End(xlUp).Row
'====Tri des lignes de données et comptage de leur nombre
For L = DerLign To PremLigne Step -1
If Range("A" & L) = "" Then Rows(L).Delete
Next
'====Formatage des nombres
Range("A" & PremLigne + 2 & ":F" & DerLign).Select
Selection.Replace What:=",", Replacement:="."
Selection.NumberFormat = "0.00"
Selection.Replace What:=" - Remboursés par REUNICA PREVOYANCE",
Replacement:=""
'====Format 1ère ligne et collage des formules colonnes I, J, K
For L = PremLigne - 1 To PremLigne - 100 Step -1
If Left(Range("A" & L), 6) = "Détail" Then Exit For
Next
LignModeleTitre = L
Rows(LignModeleTitre).Copy
Rows(PremLigne).PasteSpecial Paste:=xlFormats
Range("I" & LignModeleTitre & ":K" & LignModeleTitre).Copy
Destination:=Range("I" & PremLigne & ":K" & PremLigne)
'====Copie-Collage des formules des autres lignes
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
End Sub
LSteph a écrit :Bonjour,
Manque le début et la fin , si le pb est sensé venir du code!
Cordialement
--
lSteph
On 21 oct, 14:19, LANIMAL wrote:Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci de ton attention,
Voilà, je te mets tout.
La suppression des dr est quasi instantanée,
Ce sont les écritures et Copier-Coller qui sont lents.
Il y a des formules dépendantes dans d'autres feuilles,
peut-être est-ce la cause.
J'ai essayé : " Application.Calculation = False "
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci
Sub Reformat_Réunica()
If Selection.Columns.Count <> 5 Then Exit Sub
PremLigne = Selection.Row
DerLign = Range("A20000").End(xlUp).Row
For Each dr In ActiveSheet.Shapes 'Ajouter +1 à Derlign car le
dernier objet a le pied dans Derlign+1
If Not Intersect(dr.TopLeftCell, Range("A" & PremLigne & ":H" &
DerLign + 1)) Is Nothing _
And Not Intersect(dr.BottomRightCell, Range("A" & PremLigne & ":H"
& DerLign + 1)) Is Nothing Then dr.Delete
Next
'====Re-écriture du tableau
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1 & ":C" & PremLigne + 1).NumberFormat =
"dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
Range("A" & PremLigne + 1 & ":A" & PremLigne + 2).HorizontalAlignment
= xlRight
'====Suppression 11 lignes devenues inutiles
Rows(PremLigne + 3 & ":" & PremLigne + 13).Select
Selection.Delete
DerLign = Range("A20000").End(xlUp).Row
'====Tri des lignes de données et comptage de leur nombre
For L = DerLign To PremLigne Step -1
If Range("A" & L) = "" Then Rows(L).Delete
Next
'====Formatage des nombres
Range("A" & PremLigne + 2 & ":F" & DerLign).Select
Selection.Replace What:=",", Replacement:="."
Selection.NumberFormat = "0.00"
Selection.Replace What:=" - Remboursés par REUNICA PREVOYANCE",
Replacement:=""
'====Format 1ère ligne et collage des formules colonnes I, J, K
For L = PremLigne - 1 To PremLigne - 100 Step -1
If Left(Range("A" & L), 6) = "Détail" Then Exit For
Next
LignModeleTitre = L
Rows(LignModeleTitre).Copy
Rows(PremLigne).PasteSpecial Paste:=xlFormats
Range("I" & LignModeleTitre & ":K" & LignModeleTitre).Copy
Destination:=Range("I" & PremLigne & ":K" & PremLigne)
'====Copie-Collage des formules des autres lignes
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
End Sub
LSteph a écrit :
Bonjour,
Manque le début et la fin , si le pb est sensé venir du code!
Cordialement
--
lSteph
On 21 oct, 14:19, LANIMAL <nore...@xxx.yy> wrote:
Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci de ton attention,
Voilà, je te mets tout.
La suppression des dr est quasi instantanée,
Ce sont les écritures et Copier-Coller qui sont lents.
Il y a des formules dépendantes dans d'autres feuilles,
peut-être est-ce la cause.
J'ai essayé : " Application.Calculation = False "
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
Merci
Sub Reformat_Réunica()
If Selection.Columns.Count <> 5 Then Exit Sub
PremLigne = Selection.Row
DerLign = Range("A20000").End(xlUp).Row
For Each dr In ActiveSheet.Shapes 'Ajouter +1 à Derlign car le
dernier objet a le pied dans Derlign+1
If Not Intersect(dr.TopLeftCell, Range("A" & PremLigne & ":H" &
DerLign + 1)) Is Nothing _
And Not Intersect(dr.BottomRightCell, Range("A" & PremLigne & ":H"
& DerLign + 1)) Is Nothing Then dr.Delete
Next
'====Re-écriture du tableau
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1 & ":C" & PremLigne + 1).NumberFormat =
"dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
Range("A" & PremLigne + 1 & ":A" & PremLigne + 2).HorizontalAlignment
= xlRight
'====Suppression 11 lignes devenues inutiles
Rows(PremLigne + 3 & ":" & PremLigne + 13).Select
Selection.Delete
DerLign = Range("A20000").End(xlUp).Row
'====Tri des lignes de données et comptage de leur nombre
For L = DerLign To PremLigne Step -1
If Range("A" & L) = "" Then Rows(L).Delete
Next
'====Formatage des nombres
Range("A" & PremLigne + 2 & ":F" & DerLign).Select
Selection.Replace What:=",", Replacement:="."
Selection.NumberFormat = "0.00"
Selection.Replace What:=" - Remboursés par REUNICA PREVOYANCE",
Replacement:=""
'====Format 1ère ligne et collage des formules colonnes I, J, K
For L = PremLigne - 1 To PremLigne - 100 Step -1
If Left(Range("A" & L), 6) = "Détail" Then Exit For
Next
LignModeleTitre = L
Rows(LignModeleTitre).Copy
Rows(PremLigne).PasteSpecial Paste:=xlFormats
Range("I" & LignModeleTitre & ":K" & LignModeleTitre).Copy
Destination:=Range("I" & PremLigne & ":K" & PremLigne)
'====Copie-Collage des formules des autres lignes
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
End Sub
LSteph a écrit :Bonjour,
Manque le début et la fin , si le pb est sensé venir du code!
Cordialement
--
lSteph
On 21 oct, 14:19, LANIMAL wrote:Bonjour,
Je suppose la question élémentaire, encore une qui m'échappe !
La procédure suivante est utilisée pour changer la présentation d'un
tableau (téléchargé).
Range("A" & PremLigne & ":H" & DerLign).UnMerge
Range("A" & PremLigne + 1) = "Traité / Réglé le :"
Range("B" & PremLigne + 1) = Range("A" & PremLigne + 4)
Range("C" & PremLigne + 1) = Range("B" & PremLigne + 4)
Range("B" & PremLigne + 1).NumberFormat = "dd/mm/yy"
Range("A" & PremLigne + 2) = "Totaux du décompte :"
Range("B" & PremLigne + 2) = Range("A" & PremLigne + 7)
Range("C" & PremLigne + 2) = Range("B" & PremLigne + 7)
Range("D" & PremLigne + 2) = Range("C" & PremLigne + 7)
L'exécution est lente.
L'instruction Application.SreenUpdating = False ne change rien.
Y aurait-il une autre méthode ?
Merci
Bonsoir,Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
'Au début de macro
Application.Calculation = xlCalculationManual
'et a la fin
Application.Calculation = xlCalculationAutomatic
Essaie aussi de supprimer les "select "
Exemple, ceci
'------------
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
'*******Donne
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy Range("G" & PremLigne + 3 & ":G" &
DerLign)
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
Ps: pas testé si la plage de collage est correcte "Range("G" & PremLigne +
3 & ":G" & DerLign)"
Bonsoir,
Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
'Au début de macro
Application.Calculation = xlCalculationManual
'et a la fin
Application.Calculation = xlCalculationAutomatic
Essaie aussi de supprimer les "select "
Exemple, ceci
'------------
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
'*******Donne
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy Range("G" & PremLigne + 3 & ":G" &
DerLign)
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
Ps: pas testé si la plage de collage est correcte "Range("G" & PremLigne +
3 & ":G" & DerLign)"
Bonsoir,Mais cette instruction est refusée, et je n'ai pas trouvé la bonne.
'Au début de macro
Application.Calculation = xlCalculationManual
'et a la fin
Application.Calculation = xlCalculationAutomatic
Essaie aussi de supprimer les "select "
Exemple, ceci
'------------
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy
Range("G" & PremLigne + 3 & ":G" & DerLign).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
'*******Donne
DerLign = Range("A20000").End(xlUp).Row
Range("G" & PremLigne - 1).Copy Range("G" & PremLigne + 3 & ":G" &
DerLign)
Application.CutCopyMode = False
Range("G" & PremLigne + 3).Select
'--------------
Ps: pas testé si la plage de collage est correcte "Range("G" & PremLigne +
3 & ":G" & DerLign)"