Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel Optimisation de macro

Optimisation de macro

12 réponses
Avatar
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
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2
Avatar
titi
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)
Avatar
Philippe
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)


Avatar
Garette
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)


Avatar
Garette
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
Avatar
FFO
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)



Avatar
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)



Avatar
Garette
Re,

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


"FFO" a écrit dans le message de news:

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)





Avatar
Garette
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" a écrit dans le message de news:

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)





Avatar
titi
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" a écrit dans le message de news:

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)








Avatar
titi
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
1 2