Recopie trop lente

Bonjour Lune Rousse,

Essaie ceci :
'-------------------------------------
Sub test()
Dim Rg As Range, M As String
On Error Resume Next
M = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
With worksheets("Feuil2")
Set Rg = .Range("C1:C" & .Range("C65536"). _
End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
End With
With worksheets("Feuil1")
Rg.Copy .Range("E" & .Range("E65536").End(xlUp)(2).Row)
End With
Application.Calculation = M
Application.EnableEvents = True
End Sub
'-------------------------------------



"Lune Rousse" <taninldn@gmail.com> a écrit dans le message de groupe de discussion :
f10b9ecc-f17b-4bb8-b5c3-ef613abde2bf@o32g2000yqm.googlegroups.com...
Bonjour,

Pour copier des cellules d’une feuille à l’autre j’ai écrit une macro
qui fonctionne mais qui est d’une lenteur exaspérante. (j’ai de 3 à
5500 lignes par feuille)
Je dois copier toutes les cellules non vides de la colonne C de la
feuille 2 sur la colonne E de la feuille 1. Bien sûr je commence à
recopier dans la première cellule non vide de la colonne E (pas de
trous dans cette colonne)

Est-il possible de mettre un fond de couleur sur la cellule de
destination ? Si oui comment ?
Cette macro peut-elle être améliorée pour augmenter sa vitesse
d’exécution ?

Merci pour votre aide.

LUNE ROUSSE

Private Sub copie_couleur()
For I = 2 To 5000
Cells(I, 3).Select
Worksheets("Extract_compar").Cells(I, 3).Copy
Sheets("dossiers_lu").Select
Range("E2").Select
Do While ActiveCell.Value > ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
Next I
End Sub

Bonjour Lune Rousse,

Essaie ceci :
'---------------------------------------
Sub test()
Dim Rg As Range, M As String
On Error Resume Next
Application.ScreenUpdating = False
M = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
With Worksheets("Feuil2")
Set Rg = .Range("C1:C" & .Range("C65536"). _
End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
End With
With Worksheets("Feuil1")
Rg.Copy .Range("E" & .Range("E65536").End(xlUp)(2).Row)
End With
Application.Calculation = M
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'---------------------------------------

Bonjour,

C'est bien le problème d'Excel avec son mode interprété, ça ne
fonctionne de façon raisonnable que sur des choses pas trop grosses ou trop
compliquées, le mieux est d'utiliser un fichier, et de dialoguer avec
celui-ci de manière à éviter un maximum de traitement directement dans les
cellules, de même, quand c'est possible, il est toujours mieux de ne pas
afficher un classeur au moment où on écrit dedans, ça augmente grandement la
vitesse.

Pou ce qui est de la gestion d'erreur

On Error Resume Next

Certes pas ! Car ce type d'écriture masquera indubitablement une autre
erreur qui pourra planter ou coincer (boucler) sans savoir pourquoi, on fera
donc :

' global
dim ou as string

sub _()
ou = "Programme X, Form Y, procédure Z"
On Error goto erreur
suite:
... ' traitement
exit sub
erreur:
if err = X then
on error resume next
goto suite
endif
msgbox "erreur = " & err & vblf & Err.Description & vblf & Err.source &
vblf & "localisation : " & ou, vbexclamation
' suite du traitement, sortie totale, de la procédure, ou retour +
effacement de l'erreur...
end sub


--
Cordialement ;o)
-
Logiciels, romans, contacts : http://irolog.free.fr
_______________________
.
.


"Lune Rousse" <taninldn@gmail.com> a écrit dans le message de
news:f10b9ecc-f17b-4bb8-b5c3-ef613abde2bf@o32g2000yqm.googlegroups.com...
Bonjour,

Pour copier des cellules d’une feuille à l’autre j’ai écrit une macro
qui fonctionne mais qui est d’une lenteur exaspérante. (j’ai de 3 à
5500 lignes par feuille)
Je dois copier toutes les cellules non vides de la colonne C de la
feuille 2 sur la colonne E de la feuille 1. Bien sûr je commence à
recopier dans la première cellule non vide de la colonne E (pas de
trous dans cette colonne)

Est-il possible de mettre un fond de couleur sur la cellule de
destination ? Si oui comment ?
Cette macro peut-elle être améliorée pour augmenter sa vitesse
d’exécution ?

Merci pour votre aide.

LUNE ROUSSE

Private Sub copie_couleur()
For I = 2 To 5000
Cells(I, 3).Select
Worksheets("Extract_compar").Cells(I, 3).Copy
Sheets("dossiers_lu").Select
Range("E2").Select
Do While ActiveCell.Value > ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.Paste
Next I
End Sub

On 13 août, 01:02, "MichDenis" <michde...@hotmail.com> wrote:

Bonjour Lune Rousse,

Essaie ceci :
'---------------------------------------
Sub test()
Dim Rg As Range, M As String
On Error Resume Next
Application.ScreenUpdating = False
M = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
With Worksheets("Feuil2")
    Set Rg = .Range("C1:C" & .Range("C65536"). _
    End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
End With
With Worksheets("Feuil1")
    Rg.Copy .Range("E" & .Range("E65536").End(xlUp)(2).Row)
End With
Application.Calculation = M
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'---------------------------------------

Bonjour,

La procédure que tu m'a données à 0h 41 fonctionne très très bien et
très vite.
Je vais essayer celle ci-dessus dans la soirée.
Si tu pouvais aussi me dire comment (au moment de la copie) mettre la
cellule copiée sur un fond en couleur (vert ou fuschia par exemple),
de façon à pouvoir identifier rapidement les cellules copiées, car à
la fin de la copie je trie, les nouvelles données sont donc très
difficilement identifiables.
Merci de ton aide
Lune Rousse

Colore les cellules qui viennent d'être copiée
dans la feuil1. Pour ce qui est du choix de couleur
tu peux choisir entre 1 et 56 dans cette ligne de
code .Interior.ColorIndex = 38

'------------------------------------------
Sub test()
Dim Rg As Range, M As String, X As Long
On Error Resume Next
Application.ScreenUpdating = False
M = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
With Worksheets("Feuil2")
Set Rg = .Range("C1:C" & .Range("C65536"). _
End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
End With
With Worksheets("Feuil1")
With .Range("E" & .Range("E65536").End(xlUp)(2).Row)
X = .Row
Rg.Copy .Item(1, 1)
End With
With .Range(.Range("E" & X), .Range("E" & .Range("E65536").End(xlUp).Row))
.Interior.ColorIndex = 38 'Choix entre 1 et 56
End With
End With
Application.Calculation = M
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'------------------------------------------


"Lune Rousse" <taninldn@gmail.com> a écrit dans le message de groupe de discussion :
cc6afedf-6f97-4dfe-8502-3727924b2802@k19g2000yqn.googlegroups.com...
On 13 août, 01:02, "MichDenis" <michde...@hotmail.com> wrote:

Bonjour Lune Rousse,

Essaie ceci :
'---------------------------------------
Sub test()
Dim Rg As Range, M As String
On Error Resume Next
Application.ScreenUpdating = False
M = Application.Calculation
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
With Worksheets("Feuil2")
Set Rg = .Range("C1:C" & .Range("C65536"). _
End(xlUp).Row).SpecialCells(xlCellTypeConstants, 23)
End With
With Worksheets("Feuil1")
Rg.Copy .Range("E" & .Range("E65536").End(xlUp)(2).Row)
End With
Application.Calculation = M
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'---------------------------------------

Bonjour,

La procédure que tu m'a données à 0h 41 fonctionne très très bien et
très vite.
Je vais essayer celle ci-dessus dans la soirée.
Si tu pouvais aussi me dire comment (au moment de la copie) mettre la
cellule copiée sur un fond en couleur (vert ou fuschia par exemple),
de façon à pouvoir identifier rapidement les cellules copiées, car à
la fin de la copie je trie, les nouvelles données sont donc très
difficilement identifiables.
Merci de ton aide
Lune Rousse