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
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
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)
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:
o1lcv2l49cvpp3ea4700i5hsd1ve1af5lj@4ax.com...
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)
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
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)
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:
o1lcv2l49cvpp3ea4700i5hsd1ve1af5lj@4ax.com...
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)
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
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
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
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
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)
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)
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
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)
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)
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
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)
Re,
dès qu'il y a du "Select", ca freine ...
"FFO" <FFO@discussions.microsoft.com> a écrit dans le message de news:
CEE5F6D5-5764-446B-91EB-6624F37A6301@microsoft.com...
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)
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
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)
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" <FFO@discussions.microsoft.com> a écrit dans le message de news:
CEE5F6D5-5764-446B-91EB-6624F37A6301@microsoft.com...
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)
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)
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)
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
te@hotmail.com> 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" <FFO@discussions.microsoft.com> a écrit dans le message de news:
CEE5F6D5-5764-446B-91EB-6624F37A6301@microsoft.com...
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)
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)
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
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
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