Simplification macro

julien974

XLDnaute Occasionnel
Bonjour,

J'ai de nouveau besoin de votre aide amis Excelien! ^^

J'aimerai optimiser la macro suivante pour un temps d'execution plus rapide.

HTML:
Sub hihi()

Sheets("Feuil2").Activate
Columns(1).ClearContents

Range("A3").Value = "DATE"
Sheets("Feuil3").Activate
Range("C2").Activate

For j = Sheets("Feuil3").Range("C2").Column To Sheets("Feuil3").Range("IV2").End(xlToLeft).Column
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Next j

End Sub

Merci de votre aide précieuse,

Juli3n974
 

mromain

XLDnaute Barbatruc
Re : Simplification macro

bonjourjulien974,

à tester :
Code:
With Sheets("Feuil2")
    .Columns(1).ClearContents
    .Range("A3").Value = "DATE"
    For j = 3 To Sheets("Feuil3").Cells(2, Sheets("Feuil3").Columns.Count).End(xlToLeft).Column
        For i = 1 To 4
            Sheets("Feuil3").Cells(2, j).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
        Next i
    Next j
End With

a+
 

julien974

XLDnaute Occasionnel
Re : Simplification macro

Rebonjour,

J'ai fais ceci et ça va un peu plus vite...
Peut on modifier le corps de la macro (la boucle)?

HTML:
Sub hihi()

Application.ScreenUpdating = False

Sheets("Feuil2").Activate
Columns(1).ClearContents

Range("A3").Value = "DATE"
Sheets("Feuil3").Activate
Range("C2").Activate

For j = Sheets("Feuil3").Range("C2").Column To Sheets("Feuil3").Range("IV2").End(xlToLeft).Column
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
    
    Sheets("Feuil3").Activate
    Cells(2, j).Copy
    Sheets("Feuil2").Activate
    Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Next j

ScreenUpdating = true
End Sub

Merci bcp
 

vbacrumble

XLDnaute Accro
Re : Simplification macro

Re


Un suggestion avec le code de mromain


Code:
Sub macro 2()
[COLOR="Green"]'Permet de réutiliser simplement le code pour l'appliquer à d'autres feuilles
'il suffit d'adapter ce qui est en bleu[/COLOR]
Dim fs As Worksheet:        Set fs = [COLOR="Blue"]Sheets("Feuil3")[/COLOR]
Dim fd As Worksheet:        Set fd = [COLOR="Blue"]Sheets("Feuil2")[/COLOR]
Application.ScreenUpdating = False
With fd
    .Columns(1).ClearContents
    .Range("A3").Value = "DATE"
    For j = 3 To fs.Cells(2, fs.Columns.Count).End(xlToLeft).Column
        For i = 1 To 4
            fs.Cells(2, j).Copy .[A66536].End(xlUp).Offset(1)
        Next i
    Next j
End With
Application.ScreenUpdating = True
End Sub
 
Dernière édition:

Pierrot93

XLDnaute Barbatruc
Re : Simplification macro

Bonjour à tous

quelque chose doit m'échapper, vois pas trop l'intérêt de la boucle :

Code:
For i = 1 To 4
    fs.Cells(2, j).Copy .[A66536].End(xlUp).Offset(1)
Next i

la variable "i" n'étant pas utilisée... c'est la même copie qui est faites..

bon après midi
@+
 

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 334
Membres
103 519
dernier inscrit
Thomas_grc11