Copie rapide d'un range d'une feuille à une autre

Le 19/02/2019 à 16:21

Bonjour,

Je cherche à optimiser mon code et à un moment je dois recopier des valeurs d'une feuille à une autre mais je trouve que cela met trop de temps et j'aimerais supprimer les select qui me font perdre trop de temps, pouvez vous m'aider ?

voici le code :

Sheets("DATA - LAPLACE v3").Select

    While i <= lignetotalmois
            nombredeligneàajouter = Sheets("SOURCE LAPLACE").Cells(i, Colonnetotalmois + 2).Value - 1

            Sheets("SOURCE LAPLACE").Select
            Range(Cells(i, 1), Cells(i, 13)).Copy

            Sheets("DATA - LAPLACE v3").Select
            Range(Cells(LigneinitialeDATA, 1), Cells(LigneinitialeDATA + nombredeligneàajouter, 13)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

     LigneinitialeDATA = LigneinitialeDATA + 1
    i = i + 1
        Wend

C'est à cet endroit ci que cela met beaucoup de temps :

            Sheets("SOURCE LAPLACE").Select
            Range(Cells(i, 1), Cells(i, 13)).Copy

            Sheets("DATA - LAPLACE v3").Select
            Range(Cells(LigneinitialeDATA, 1), Cells(LigneinitialeDATA + nombredeligneàajouter, 13)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False

En vous remerciant de votre aide

Le 19/02/2019 à 16:36

Bonjour,

Merci de joindre un fichier à ta demande.

Cdlt.

Le 19/02/2019 à 16:38

Salut!

Une astuce consiste à copier la plage qui t'intéresse et à l'insérer (au lieu de la coller)

C'est plus rapide car contrairement à la méthode 'Paste', l'insertion ne demande pas de sélectionner la feuille et la range au préalable!

Un exemple où je suis sur la feuille 2 et je copie quelque chose présent sur la feuille 1 :

Sub CopyInsert()
Sheets(1).Range("A1:K5").Copy
Rows(1).Insert
End Sub

A dispo!

Le 19/02/2019 à 16:49

Merci de votre réactivité

Le soucis en faisant ce code :

            Sheets("SOURCE LAPLACE").Range(Cells(i, 1), Cells(i, 13)).Copy
            Rows(LigneinitialeDATA).Insert

cela me met une erreur "1004 : erreur définie par l'application ou par l'objet"

Désolé mais par soucis de confidentialité je ne peux partager mon fichier

Je souhaite juste recopier des lignes d'une feuille sur une autre feuille en fonction d'une cellule qui me donne le nombre de fois que je dois copier cette ligne

Le 20/02/2019 à 00:29

Salut Zigomar56890,

Edit : J'oublie de vous saluer, l'équipe!

Á l'aveuglette, puisque sans fichier, et après "traduction"...

'
Dim sWk As Worksheet
Dim iRowA%, iStartRow%, iNbRow%, iTCol%
'iRowA = lignetotalmois
'iStartRow = ligneinitialeDATA
'iNbRow = nombredeligneàajouter
'iTCol = Colonnetotalmois
'
Set sWk = Worksheets("SOURCE LAPLACE")
'
With Worksheets("DATA - LAPLACE v3")
    While i <= iRowA
        iNbRow = sWk.Cells(i, iTCol + 2) - 1
        For x = 0 To iNbRow - 1
            .Range("A" & iStartRow + x & ":M" & iStartRow + x).Value = sWk.Range("A" & i & ":M" & i).Value
        Next
        iStartRow = iStartRow + 1
        i = i + 1
    Wend
End With
'

Juste un souci : si j'interprète bien ton code, tu recopies une ligne X fois d'un fichier à l'autre mais puisque iStartRow= iStartRow +1, tu copies sur ce que tu viens de copier!

Ne dois-tu pas plutôt copier ces données à la suite l'un de l'autre?
si oui, alors changer avec ceci :

With Worksheets("DATA - LAPLACE v3")
    While i <= iRowA
        iNbRow = sWk.Cells(i, iTCol + 2) - 1
        iStartRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
        For x = 0 To iNbRow - 1
            .Range("A" & iStartRow + x & ":M" & iStartRow + x).Value = sWk.Range("A" & i & ":M" & i).Value
        Next
        i = i + 1
    Wend
End With

A tester, sans garantie...

A+

Le 20/02/2019 à 10:05

Super merci beaucoup

C'est au top ce que tu as fait. j'ai pu m'inspirer grâce à au "with" qui marche niquel

Voici le bout de code au complet pour ceux que ça intéresse :

        Set sWk = Worksheets("SOURCE LAPLACE")
        With Worksheets("DATA - LAPLACE v3")

            While i <= lignetotalmois
                nombredeligneàajouter = sWk.Cells(i, Colonnetotalmois + 2).Value - 1    'récupération du nombre de ligne à copier = nombre de jours que travaille la ressource
                .Range("A" & LigneinitialeDATA & ":M" & LigneinitialeDATA + nombredeligneàajouter).Value = sWk.Range("A" & i & ":M" & i).Value   'copie de la ligne multiplié par le nombre de jour travaillé(=nombredeligneàajouter)

                j = sWk.Cells(i, Colonnetotalmois + 4).Value + 13 'récupére la position du 1er "1" (=1er jour où la ressource est utilisé) pour gagner du temps d'execution

                If nombredeligneàajouter > 0 Then  'si la ressource travaille plusieurs jours

                    .Cells(LigneinitialeDATA, 18) = sWk.Cells(5, j)  'copie le jour où la ressource travaille
                    i5 = 0
                    LigneinitialeDATA = LigneinitialeDATA + 1

                    While i5 < nombredeligneàajouter  'pour récupèrer le jour où la ressource travaille pour les lignes précèdement copiées

                        j = j + 1
                        a = 0

                        While j <= Colonnetotalmois And a = 0
                            If sWk.Cells(i, j) = 1 Then
                               .Cells(LigneinitialeDATA, 18) = sWk.Cells(5, j)
                               a = 1
                            Else
                                j = j + 1
                            End If
                        Wend
                        i5 = i5 + 1
                        LigneinitialeDATA = LigneinitialeDATA + 1

                    Wend

                Else  'si la ressource ne travaille qu'un seul jours

                    .Cells(LigneinitialeDATA, 18) = sWk.Cells(5, j).Value
                    LigneinitialeDATA = LigneinitialeDATA + 1

                End If

                i = i + 1
            Wend

        End With

Merci beaucoup

Le 21/02/2019 à 09:17

Bonjour,

Finalement la macro reste beaucoup trop lente.

Je vous met ci -joint un fichier test pour vous montrer ce que je souhaite faire.

Faites tourner la macro pour voir le résultat.

Le problème c'est que mes listes sont très longues et cela met un temps fou et j'aurais besoin de votre aide pour optimiser cette macro

Vous avez une feuille en rab pour recopier les données sur la feuille 1 pour éviter de remettre des "1" dans les colonnes temps.

En vous remerciant

3feuil1.xlsm (184.60 Ko)

Le 21/02/2019 à 15:12

Alors en regardant de plus près le problème vient de la récupération du jour travaillé.

En effet, si j'enlève le code de récupération du jour, la macro à un bon timing < voila le code sans la récupération (j'ai mis en commentaires les lignes de codes qui récupère le jour travaillé)

            Set sWk = Worksheets("SOURCE LAPLACE")
            With Worksheets("DATA - LAPLACE v3")

                For i = 6 To lignetotalmois
                    nombredeligneàajouter = sWk.Cells(i, Colonnetotalmois + 2).Value - 1    'récupération du nombre de ligne à copier = nombre de jours que travaille la ressource
                    .Range("A" & LigneinitialeDATA & ":M" & LigneinitialeDATA + nombredeligneàajouter).Value = sWk.Range("A" & i & ":M" & i).Value   'copie de la ligne multiplié par le nombre de jour travaillé(=nombredeligneàajouter)
                    .Range("U" & LigneinitialeDATA & ":U" & LigneinitialeDATA + nombredeligneàajouter).Value = sWk.Range(sWk.Cells(i, Colonnetotalmois + 3), sWk.Cells(i, Colonnetotalmois + 3)).Value  'copie des commentaires

                    'j = sWk.Cells(i, Colonnetotalmois + 4).Value + 13 'récupére la position du 1er "1" (=1er jour où la ressource est utilisé) pour gagner du temps d'execution

                    If nombredeligneàajouter > 0 Then  'si la ressource travaille plusieurs jours

                        '.Cells(LigneinitialeDATA, 18) = sWk.Cells(5, j)  'copie le jour où la ressource travaille
                        LigneinitialeDATA = LigneinitialeDATA + 1

                        For i5 = 1 To nombredeligneàajouter 'pour récupèrer le jour où la ressource travaille pour les lignes précèdement copiées
                            'sWk.Cells(i, j).ClearContents 'supprime le jour travaillé pour récupérer la position du prochain jour travaillé via la formule en Cells(i, Colonnetotalmois + 4)
                            'j = sWk.Cells(i, Colonnetotalmois + 4).Value + 13 'récupérer la nouvelle position
                            '.Cells(LigneinitialeDATA, 18) = sWk.Cells(5, j).Value 'ajout de la date
                            LigneinitialeDATA = LigneinitialeDATA + 1
                        Next

                    Else  'si la ressource ne travaille qu'un seul jours

                        '.Cells(LigneinitialeDATA, 18) = sWk.Cells(5, j).Value
                        LigneinitialeDATA = LigneinitialeDATA + 1

                    End If

                Next

            End With

Avez vous des idées pour améliorer la vitesse d’exécution ?

En vous remerciant,

Rechercher des sujets similaires à "copie rapide range feuille"