Optimisation de macro

Le
titi
bonjour,

j'ai ecrit une macro qui me copie tous mes cellules pleines( colonne
A) de A2 ( libellé en A1 ) jusqu'a la dernière cellule pleine pour
ensuite aller coller çà sur une nouvelle feuille vierge à l'identique.
en fait je fais un copier de A2 puis un offset sur A3
je passe sur la feuille 2
je fais un coller sur A2 puis un offset sur A3
je repasse sur la feuille 1
je fais un copier de A3 puis un offset sur A4
je repasse sur la feuille 2
etc etc

Mon probleme est que ma macro fonctionne cellule par cellule d'ou des
temps de traitement ( sur 600 cellules ) extremements longs

y'a t'il moyen d'ameliorer ceci ?


Merci de vos conseils
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 2
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
titi
Le #4330151
Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)
Philippe
Le #4330091
Bonjour

tu peux copier la plage en une fois, de A2 jusqu'a la prochaine cellule non
vide :
With Sheets("09-03-07")
.Sheets("09-03-07").Range(.Range("A2"),
.Range("A2").End(xlDown)).Copy Destination:=Sheets("Feuil1").Range("A2")
End With
voilà ...
Bonne journée

<titi> a écrit dans le message de news:

Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)


Garette
Le #4330081
Bonjour,

Une premiere solution qui evite de boucler et de faire des Select :

Sub Test2()
With Sheets("09-03-07")
.Range("A2:" & .Range("A65536").End(xlUp).Address).Copy
(Sheets("Feuil1").Range("A2"))
End With
End Sub


<titi> a écrit dans le message de news:

Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)


Garette
Le #4330061
Re,

Un exemple avec une boucle (qui ne fait pas de Select) :

Sub Test3()
For Each X In Sheets("09-03-07").Range("A2:" &
Sheets("09-03-07").Range("A65536").End(xlUp).Address)
X.Copy (Sheets("Feuil1").Cells(X.Row, X.Column))
Next
End Sub
FFO
Le #4330021
Salut à toi
J'ai essayé ton code en l'état et à la première cellule vide de la feuille
de tes données source le code s'arrète ce qui n'est pas le cas si toutes sont
pleines
Je te propose celui-ci qui fonctionne trés bien (5 secondes pour traiter
plus de 1200 cellules) :
Sheets("Destination").Select
Range("A1").Select
Sheets("Source").Select
Range("A1").Offset(65535, 0).End(xlUp).Select
A = ActiveCell.Address
Range("A1").Select
Do While ActiveCell.Address <> Range(A).Address
If ActiveCell <> "" Then
ActiveCell.Copy
Sheets("Destination").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
End If
Sheets("Source").Select
ActiveCell.Offset(1, 0).Select
Loop

Qu'en penses tu ???


Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)



FFO
Le #4330001
Encore plus fort (3 seconde pour plus de 2400 cellules)
Consiste à recopier en l'état ta colonne source dans la 2° feuille et de
supprimer les cellules vides avec ce code :
Sheets("Source").Select
Range("A1", [A1].Offset(65535, 0).End(xlUp)).Copy
Sheets("Destination").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Offset(65535, 0).End(xlUp).Select
Do While ActiveCell.Address <> Range("A1").Address
If ActiveCell = "" Then
ActiveCell.Delete
End If
ActiveCell.Offset(-1, 0).Select
Loop
'Pour la 1° cellule éventuellement vide
If ActiveCell = "" Then
ActiveCell.Delete
End If

C'est y pas mieux ????


Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)



Garette
Le #4329981
Re,

dès qu'il y a du "Select", ca freine ...


"FFO"
Encore plus fort (3 seconde pour plus de 2400 cellules)
Consiste à recopier en l'état ta colonne source dans la 2° feuille et de
supprimer les cellules vides avec ce code :
Sheets("Source").Select
Range("A1", [A1].Offset(65535, 0).End(xlUp)).Copy
Sheets("Destination").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Offset(65535, 0).End(xlUp).Select
Do While ActiveCell.Address <> Range("A1").Address
If ActiveCell = "" Then
ActiveCell.Delete
End If
ActiveCell.Offset(-1, 0).Select
Loop
'Pour la 1° cellule éventuellement vide
If ActiveCell = "" Then
ActiveCell.Delete
End If

C'est y pas mieux ????


Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)





Garette
Le #4329961
Re,

Le code suivant est immediat sur 20000 lignes :

Sub Test2()
With Sheets("09-03-07")
.Range("A2:" & .Range("A65536").End(xlUp).Address).Copy
End With
Sheets("Feuil1").Select
Range("A2").Select
ActiveSheet.Paste
End Sub


"FFO"
Encore plus fort (3 seconde pour plus de 2400 cellules)
Consiste à recopier en l'état ta colonne source dans la 2° feuille et de
supprimer les cellules vides avec ce code :
Sheets("Source").Select
Range("A1", [A1].Offset(65535, 0).End(xlUp)).Copy
Sheets("Destination").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Offset(65535, 0).End(xlUp).Select
Do While ActiveCell.Address <> Range("A1").Address
If ActiveCell = "" Then
ActiveCell.Delete
End If
ActiveCell.Offset(-1, 0).Select
Loop
'Pour la 1° cellule éventuellement vide
If ActiveCell = "" Then
ActiveCell.Delete
End If

C'est y pas mieux ????


Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)





titi
Le #4329791
oui

effectivement
il n'y a pas photo concernant le temps de traitement

me reste plus qu' à décortiquer tout ca et à comprendre comment ca
marche

en tout cas bravo et merci



wrote:

Re,

Le code suivant est immediat sur 20000 lignes :

Sub Test2()
With Sheets("09-03-07")
.Range("A2:" & .Range("A65536").End(xlUp).Address).Copy
End With
Sheets("Feuil1").Select
Range("A2").Select
ActiveSheet.Paste
End Sub


"FFO"
Encore plus fort (3 seconde pour plus de 2400 cellules)
Consiste à recopier en l'état ta colonne source dans la 2° feuille et de
supprimer les cellules vides avec ce code :
Sheets("Source").Select
Range("A1", [A1].Offset(65535, 0).End(xlUp)).Copy
Sheets("Destination").Select
Range("A1").Select
ActiveSheet.Paste
Range("A1").Offset(65535, 0).End(xlUp).Select
Do While ActiveCell.Address <> Range("A1").Address
If ActiveCell = "" Then
ActiveCell.Delete
End If
ActiveCell.Offset(-1, 0).Select
Loop
'Pour la 1° cellule éventuellement vide
If ActiveCell = "" Then
ActiveCell.Delete
End If

C'est y pas mieux ????


Pour etre plus précis
voilà ce que ca donne en bout de code:

Sheets("Feuil1").Select
Range("A2").Select

Sheets("09-03-07").Select
Range("A2").Select
Do
Selection.Copy
ActiveCell.Offset(1, 0).Activate
Sheets("Feuil1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Activate
Sheets("09-03-07").Select
Loop Until IsEmpty(ActiveCell)








titi
Le #4328971
Il y a une chose qui m'échappe

j'ai inclus un module à votre exemple pour repeter l'operation à
partir d'une deuxième feuille

concretement
on copie les cellules pleines de la colonne A de la feuille 2 vers la
feuille 1
puis j'ai voulu copier les cellules pleines de la colonne A de la
feuille 3 vers la feuille 1 ( à la suite des cellules collées)

ca marche sauf....

que sytematiquement la cellule n-1 est tronquée lors du coller
et que ce soit avec
Range("A65536").End(xlUp).Select
ou
Range("A2").End(xlDown).Select



Sub Macro1()

With Sheets("12-03-07")
.Range("A2:" & .Range("A65536").End(xlUp).Address).Copy
End With
Sheets("Feuil1").Select
Range("A2").Select
ActiveSheet.Paste

With Sheets("09-03-07")
.Range("A2:" & .Range("A65536").End(xlUp).Address).Copy
End With
Sheets("Feuil1").Select
Range("A65536").End(xlUp).Select
ActiveSheet.Paste
End Sub


Pourquoi à vore avis ?


Merci
Publicité
Poster une réponse
Anonyme