Discussion :

[jpma75]

Bonjour,

Je pense qu'il y a un problème dans la boucle suivante si j'en juge par sa lenteur d'exécution.

En résumé :
* Feuil02, plage F2 à Fx : les données à copier dans les onglets créés.
* Feuil1 : onglet de référence (les onglets suivants sont nommés "2", "3", "4", etc.).
* L'index de Feuil1 : 3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
w = 3       'index de Feuil1 (1ère fiche à dupliquer)
 
For x = 2 To z + 1    'nb de lignes de "Feuil02" à recopier 
     If Feuil02.Range("F" & x).Value <> "" Then
          Feuil02.Range("F" & x).Copy
          Sheets(w).Range("F4").PasteSpecial Paste:=xlPasteValues 
          w = w + 1                          
     End If
Next x

En vous remerciant par avance pour votre aide,
Cdt

[jpma75]

PS :

J'ai vérifié (pas à pas), que la procédure prenait bien en compte les Application.SreenUpDating et Application.EnableEvents à False

[Nain porte koi]

Hello,

rien vu de particulier, mais on ne connais pas la valeur de "z" ni ce que vous entendez par "lenteur d'exécution."
C'est possible d'avoir un classeur de test et de nous dire combien de temps ça met chez vous ?

[jpma75]

Bonjour,

z = le nombre de Fiches à (dupliquer et à) renommer.
Ce nombre est variable et j'envisage de le récupérer automatiquement pour l'insérer dans le code.

Ici, le renommage de 131 Fiches prend 17 secondes (il faut 6 pour dupliquer la Feuil1 en 131 Fiches)

Cdt

[Nain porte koi]

Ok, c'est long...
Mais pour tester chez moi il me faudrait un classeur avec 131 feuilles et je n'ai pas ça sous la main.
Vous pouvez m'aider à vous aider en me fournissant un classeur de test ?

Nb : vous avez pensé à suspendre le calcul automatique ?

[eriiic]

Bonjour,
Lire et écrire cellule par cellule est assez lent.
Tu peux au moins lire tout d'un coup :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
    Dim datas, w As Long, x As Long, Z As Long
    w = 3       'index de Feuil1 (1ère fiche à dupliquer)
    Z = 5
    datas = Feuil2.Range("F2").Resize(Z).Value
    For x = 1 To UBound(datas)    'nb de lignes de "Feuil02" à recopier
        If datas(x, 1) <> "" Then
            Sheets(w).Range("F4").Value = datas(x, 1)
            w = w + 1
        End If
    Next x
End Sub

Déclarer et typer ses variables (autre que variant) accélère aussi.
Sans le fichier de travail il y aura peut-être des petites adaptations à faire
eric

[jpma75]

Bonjour,

Merci à vous deux,

Merci Eriiic pour cette proposition ; gain de 20% sur la procédure de renommage.

Cdt