rapidité copier/coller valeurs

erics83

XLDnaute Occasionnel
Bonjour,

J'ai un gros souci de rapidité pour copier et coller des valeurs ... :
J'ai un classeur, en Feuil "Eux", en K, j'ai des formules. Je souhaite copier/coller ces formules de L à HIF et les copier/coller valeurs (car les formules sont assez complexes et Excel plante....)
J'utilise ce code :
Code:
For i = 2 To Feuil5.Range("A65536").End(xlUp).Row

Sheets("Eux").Select
With Range("K" & i)
    .AutoFill Destination:=Range("K" & i & ":L" & i), Type:=xlFillDefault
    End With
    Range("L2:L" & i).Copy
    With Range(Cells(2, 12), Cells(i, dernierecolonne + 3))
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
next
= je "garde" en K la formule d'origine, la copie en L et ensuite la copie/colle/valeur jusqu'à dernierecolonne (=5648 (HIF)) et je passe à la ligne suivante et ainsi de suite.....
Il y a 4000 lignes et cela met un sacré temps......

N'y aurait-il pas un moyen plus "rapide" ? (sachant qu'il faut toujours garder la formule d'"origine" en K....)

En vous remerciant pour votre aide,
 

cp4

XLDnaute Impliqué
Bonsoir,

Pourquoi copier/coller une formule dans une autre colonne, pour ensuite faire copier/coller spécial?
Tu rallonges le temps d’exécution pour rien. Mieux vaut faire un copier/coller spécial valeur de la colonne K dans la colonne L
un essai ci-dessous à tester
VB:
For i = 2 To Feuil5.Range("A65536").End(xlUp).Row

With Sheets("Eux")
    .Range("K" & i).Copy
    .Range("K" & i).Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With
Next
Bonne soirée.
 

erics83

XLDnaute Occasionnel
Merci cp4,

J'ai dû mal formuler le besoin : les formules sont en K et je souhaite qu'elles soient coupée/collée de L à 5648 colonnes..... et comme je souhaitais garder la formule d'origine, c'es pourquoi je la copie/colle en L et ensuite, à partir de L, je vais jusque HIF.....

En fait, c'est surtout le copier/coller/valeur qui "prend" du temps d'exécution.....

Merci pour votre aide,

(et merci pour le lien vers JB, son site est une source inépuisable de tutos....hyper-utiles...)
 

cp4

XLDnaute Impliqué
J'ai dû mal formuler le besoin : les formules sont en K et je souhaite qu'elles soient coupée/collée de L à 5648 colonnes..... et comme je souhaitais garder la formule d'origine, c'es pourquoi je la copie/colle en L et ensuite, à partir de L, je vais jusque HIF.....

En fait, c'est surtout le copier/coller/valeur qui "prend" du temps d'exécution.....
Bonjour,
STP, peux-tu joindre un fichier avec quelques lignes sur une feuille et sur une autre le résultat que tu voudrais obtenir. Merci.

Bonne journée.

ps: je ne pourrai répondre que ce soir ou demain.
 

job75

XLDnaute Barbatruc
Bonjour erics83, cp4,

Plutôt bizarres vos copier-coller : à partir de la colonne L toutes les colonnes sont identiques...

D'après ce que je crois comprendre ceci est plus cohérent :
Code:
Sub Remplissage()
Dim dercol As Integer, derlig As Long, w As Worksheet
dercol = Feuil3.Range("G470").End(xlToRight).Column 'pourquoi 470 ???
derlig = Feuil5.Range("A65536").End(xlUp).Row
For Each w In Sheets(Array("E", "C", "R"))
    w.Range("K2:K" & derlig).AutoFill w.Range("K2", w.Cells(derlig, dercol + 3)), xlFillValues 'copie les formules de la colonne K vers la droite
    w.Range("L2", w.Cells(derlig, dercol + 3)) = w.Range("L2", w.Cells(derlig, dercol + 3)).Value 'supprime les formules à partir de la colonne L
Next
End Sub
A+
 

erics83

XLDnaute Occasionnel
Bonjour Job75,

Merci pour ce code qui effectivement fonctionne parfaitement.

Par contre, je l'ai testé avec mon fichier "complet", et j'ai le même problème : plantage de Excel suite à un nombre important de calculs.....et dans le cas de votre code, c'est l'autofill qui pose problème : comme le nombre de calcul est important, au moment de l'autofill, Excel "plante", c'est pour cette raison que j'avais essayé ligne par ligne, et en copiant/collant valeurs....

Je mets le fichier test à jour avec toutes les lignes et correction de l'erreur que vous m'avez signalée (j'avais fait un copié/collé malheureux...).

Merci pour votre aide,
 

Fichiers joints

job75

XLDnaute Barbatruc
Re,

Sur le nouveau fichier j'ai d'abord utilisé cette macro :
Code:
Sub Remplissage1()
Dim dercol As Integer, derlig As Long, w As Worksheet, t
dercol = Feuil3.Range("G470").End(xlToRight).Column 'pourquoi 470 ???
derlig = Feuil5.Range("A65536").End(xlUp).Row
For Each w In Sheets(Array("E", "R", "C"))
    t = Timer
    w.Range("K2:K" & derlig).AutoFill w.Range("K2", w.Cells(derlig, dercol + 3)), xlFillValues 'copie les formules de la colonne K vers la droite
    MsgBox "Feuille " & w.Name & " traitée en " & Int(Timer - t) & " secondes"
Next
End Sub
On a ici dercol = 189 et derlig = 6883, au total sur chaque feuille 181 x 6882 = 1245642 cellules sont traitées.

La feuille "E" se remplit chez moi en 20 secondes, la feuille "R" en 4 secondes.

Par contre Excel refuse d'aller jusqu'au bout sur la feuille "C" (les formules sont très lourdes).

J'ai ensuite essayé cette macro, plus agréable grâce aux infos dans la barre d'état :
Code:
Sub Remplissage2()
Dim dercol As Integer, derlig As Long, w As Worksheet, t, col As Integer
dercol = Feuil3.Range("G470").End(xlToRight).Column 'pourquoi 470 ???
derlig = Feuil5.Range("A65536").End(xlUp).Row
For Each w In Sheets(Array("E", "R", "C"))
    t = Timer
    For col = 12 To dercol + 3
        w.Range("K2:K" & derlig).Copy w.Cells(2, col) 'copie la colonne K vers la droite
        DoEvents
        Application.StatusBar = Int(Timer - t) & " sec - col " & col - 11 & "/" & dercol - 8 & Format((col - 11) / (dercol - 8), " - 0%")
    Next
    MsgBox "Feuille " & w.Name & " traitée en " & Int(Timer - t) & " secondes"
Next
End Sub
Mais c'est pareil : chez moi Excel bloque à la 170ème colonne traitée sur 181.

A+
 

erics83

XLDnaute Occasionnel
Merci Job75,

Oui, c'est ce qui m'arrive aussi....d'où le passage par coller/valeurs qui pourrait être une solution de "contournement" car je pense que la mémoire est saturée avec toutes les formules à traiter....des 3 feuilles....
D'où mon idée de traiter ligne par ligne en copiant/collant/valeurs (car en fait, c'est la somme (=colonne J) qui m'intéresse le plus..).

Peut-être en prenant chaque feuille l'une après l'autre....
En copiant collant/valeurs l'intégralité de "E" lorsqu'elle est calculée et passer à l'autre feuille ?

Merci pour votre aide,
A+
 
Dernière édition:

job75

XLDnaute Barbatruc
Re,

Oui les formules de la feuille "C" alourdissent énormément le fichier, il faut les supprimer après chaque copier-coller :
Code:
Sub Remplissage3()
Dim dercol As Integer, derlig As Long, w As Worksheet, t, col As Integer
dercol = Feuil3.Range("G470").End(xlToRight).Column 'pourquoi 470 ???
derlig = Feuil5.Range("A65536").End(xlUp).Row
For Each w In Sheets(Array("E", "R", "C"))
    t = Timer
    For col = 12 To dercol + 3
        w.Range("K2:K" & derlig).Copy w.Cells(2, col) 'copie la colonne K vers la droite
        w.Cells(2, col).Resize(derlig - 1) = w.Cells(2, col).Resize(derlig - 1).Value 'supprime les formules
        DoEvents
        Application.StatusBar = Int(Timer - t) & " sec - col " & col - 11 & "/" & dercol - 8 & Format((col - 11) / (dercol - 8), " - 0%")
    Next
    MsgBox "Feuille " & w.Name & " traitée en " & Int(Timer - t) & " secondes"
Next
End Sub
Durées des remplissages chez moi :

- feuille "E" => 53 secondes

- feuille "R" => 19 secondes

- feuille "C" => 882 secondes.

Fichier joint, après remplissage sont poids est seulement de 13 Mo.

A+
 

Fichiers joints

erics83

XLDnaute Occasionnel
Re-bonjour et Merci Job75,

Votre code est parfait !! je cherchais par lignes et en fait, effectivement, par colonne c'est beaucoup plus rapide !

Par contre, j'ai dû inverser les Array car les résultats de R dépendent de C (mais vous ne pouviez pas le savoir).

En terme de rapidité, avec mon fichier source :
E : 99 secondes
C : 766
R : 64

donc......PARFAIT !!!!!

Merci !!!!

et merci pour le "statusBar", que je connaissais pas, mais que je vais ré-utiliser.....

Merci,
A+
 

laurent950

XLDnaute Impliqué
Bonsoir

VB:
Sub copiecolle()
'
Dim dernierecolonne As Long
Dim i As Long

Application.DisplayStatusBar = True
Application.ScreenUpdating = False
' compteur du temps d'exécution
Start = Timer

'Application.ScreenUpdating = False
' Feuil3 = TCD
    Dim FTDC As Worksheet
        Set FTDC = Worksheets("TCD")

dernierecolonne = FTDC.Range("G470").End(xlToRight).Column

    Dim FCom As Worksheet
        Set FCom = Worksheets("Com")
        ' Feuil5 = Com

' Stock dans une variable tableau
Dim tabFormul() As Variant
ReDim tabFormul(2 To FCom.Range("A65536").End(xlUp).Row, 1 To FTDC.Range("G470").End(xlToRight).Column)

For i = 2 To FCom.Range("A65536").End(xlUp).Row

' Feuil7 = E
    Dim FE As Worksheet
        Set FE = Worksheets("E")
        ' Sheets("E").Select

    With FE.Range("K" & i)
         .AutoFill Destination:=FE.Range("K" & i & ":L" & i), Type:=xlFillDefault
    End With
  
    FE.Range("L2:L" & i).Copy
  
    With FE.Range(FE.Cells(2, 12), FE.Cells(i, dernierecolonne + 3))
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

' Feuil11 = C
    Dim FC As Worksheet
        Set FC = Worksheets("C")
        'Sheets("C").Select
  
    With FC.Range("K" & i)
        .AutoFill Destination:=FC.Range("K" & i & ":L" & i), Type:=xlFillDefault
    End With
  
    FC.Range("L2:L" & i).Copy
  
    With FC.Range(FC.Cells(2, 12), FC.Cells(i, dernierecolonne + 3))
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

' Feuil8 = R
    Dim FR As Worksheet
        Set FR = Worksheets("R")
        'Sheets("R").Select
  
    With FR.Range("K" & i)
        .AutoFill Destination:=FR.Range("K" & i & ":L" & i), Type:=xlFillDefault
    End With
      
    FR.Range("L2:L" & i).Copy
  
    With FR.Range(FR.Cells(2, 12), FR.Cells(i, dernierecolonne + 3))
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

Application.StatusBar = Timer - Start & " secondes" & " - reste Lignes à traiter = " & FCom.Range("A65536").End(xlUp).Row - i
Next i
MsgBox "durée du traitement: " & Timer - Start & " secondes"
Application.DisplayStatusBar = False
Application.ScreenUpdating = True
End Sub
 

Discussions similaires


Haut Bas