Optinisation d'une copie

[AlexandreLEGRAND]

Bonjour,
Après une recherche infructueuse, je viens vers vous.
Je cherchais à faire une copie multiple de plusieurs cases, via un bouton, vers une autre feuille...
Avec un coup d'enregistreur, j'ai eu ce que je voulais.
Cependant, à chaque sélection, ça saute (visuellement) de feuille à feuille.
Alors je me pose la question de l'optimisation.

Sheets("Feuil1").Select
Application.Goto Reference:="nom"
Selection.Copy
Sheets("Feuil2").Select
Range("Tab_nom").Select
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True
Application.CutCopyMode = False​

D'avance merci pour votre aide.

 

[Staple1600]

Re : Optinisation d'une copie

Bonsoir à tous

AlexandreLEGRAND [Bienvenue sur le forum]
Vois si ces deux exemples ont pour toi à voir avec de l'optimisation de code VBA 😉

Sub testA()
Range("nom").Copy
Sheets("Feuil1").Range("tab_nom").PasteSpecial xlPasteValues, True
End Sub

Sub testB()
Dim nbl&, nbc&
With Range("nom")
nbl = .Rows.Count: nbc = .Columns.Count
End With
Sheets("Feuil1").Range("tab_nom").Resize(nbl, nbc).Value = Range("nom").Value
End Sub

PS: Joindre un fichier Excel exemple pourrait ne pas être inutile...🙄
C'est d'ailleurs ce que conseille la charte du forum que je suppose tu as bien sur lu 😉

 

[AlexandreLEGRAND]

Re : Optinisation d'une copie

Bonsoir,
Merci beaucoup de votre aide.
J'ai essayé le premier exemple qui me semblait plus "optimisé"...
Cependant, j'ai une erreur '400'... 🙁
Je vous laisse un exemple de mon enregistrement.

 

[Staple1600]

Re : Optinisation d'une copie

Bonsoir à tous


1) Dans ton classeur, on ne trouve pas de plages nommées nom ou Tab_nom, ni de Feuil2
2) On ne trouve pas trace de la macro de ton premier message

Alors soit je me mets en mode chafouin, soit j'attends une nouvelle PJ plus étoffée et détaillée (et qui colle à ce que relate ton premier message), ou je vais m'abrutir devant mon TV set 😉

A toi de voir, camarade 😉

 

[AlexandreLEGRAND]

Re : Optinisation d'une copie

Oups... pardon
C'est moi, mauvais fichier.....

 

[Staple1600]

Re : Optinisation d'une copie

Re,

Vois si cela peut s'appeler optimisation

Sub Copie()
[Tab_nom] = [nom].Item(1)
[Tab_nom].Offset(1) = [nom].Item(1, 6).Value
End Sub

ou encore cela

Sub Copie2()
With Sheets(1)
    [Tab_nom].Resize(2) = _
    Application.Transpose(Array(.Range(Split([nom].Address(0, 0), ",")(0)), .Range(Split([nom].Address(0, 0), ",")(1))))
End With
End Sub

sans oublier ceci

Sub Copie3()
[Tab_nom].Resize(2) = Application.Transpose(Array(Sheets(1).[B2], Sheets(1).[G2]))
End Sub

 

[AlexandreLEGRAND]

Re : Optinisation d'une copie

Bonsoir,
Merci de votre aide si rapide, je me suis jeté sur le dernier exemple, hélas, 'erreur d'incompatibiliée'... zut 🙁
Cependant les deux autres fonctionnent parfaitement.
L'exemple n°2 me semble assez complexe pour que je le transpose dans mon document sans erreur de ma part.
J'aimerai, en effet, copie plusieurs zone associé vers ma deuxième feuille.
Je teste, et je vous tiens au courant

NB: Je vais ouvrir une nouvelle discussion pour une autre question.

 

[AlexandreLEGRAND]

Re : Optinisation d'une copie

Re bonsoir,
Ca se complique quelque peu...
Mon document évolue, lui.
Mais pas mon code...

 

[Staple1600]

Re : Optinisation d'une copie

Bonsoir à tous


Test OK avec ta nouvelle PC avec cette macro pas forcément de la plus belle facture, mais simplement basiquement fonctionnelle.

Sub Copie()
Dim dl& 'déclaration variable
Application.ScreenUpdating = False 'on fige le rafraichissement écran
dl = Sheets(1).Cells(Rows.Count, "A").End(3).Row - 4 'on identife le nombre de lignes des tableaux
Sheets(1).Range(Split([nom].Address, ",")(0)).Resize(dl).Copy 'on copie le premier tableau
With [Tab_nom]
    .PasteSpecial Paste:=xlPasteAll, Transpose:=True 'on le transpose
    Sheets(1).Range(Split([nom].Address, ",")(1)).Resize(dl).Copy ' on copie le second tableau
    .End(xlDown)(2).PasteSpecial Paste:=xlPasteAll, Transpose:=True ' on le transpose à la suite
    .CurrentRegion.HorizontalAlignment = xlCenter 'on aligne le contenu horizontalement au centre
End With
Application.Goto [Tab_nom] 'on sélectionne Tab_nom
Application.CutCopyMode = False 'on vide le ClipBoard (Presse-papier)
Application.ScreenUpdating = True 'on défige le rafraichissement
End Sub

NB: On utilise Split et .Address pour déterminer l'adresse des cellules des deux "tableaux".

 

[AlexandreLEGRAND]

Re : Optinisation d'une copie

Bonsoir à tous
Test OK avec ta nouvelle PC avec cette macro pas forcément de la plus belle facture, mais simplement basiquement fonctionnelle.
Sub Copie()
Dim dl&
Application.ScreenUpdating = False Ceci pour empecher le passage d'une page à une autre?
dl = Sheets(1).Cells(Rows.Count, "A").End(3).Row - 4
Sheets(1).Range(Split([nom].Address, ",")(0)).Resize(dl).Copy
With [Tab_nom]
.PasteSpecial Paste:=xlPasteAll, Transpose:=True la copie en transpose
Sheets(1).Range(Split([nom].Address, ",")(1)).Resize(dl).Copy
.End(xlDown)(2).PasteSpecial Paste:=xlPasteAll, Transpose:=True
.CurrentRegion.HorizontalAlignment = xlCenter
End With
Application.Goto [Tab_nom]
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Merci beaucoup pour votre aide, par contre je comprends pas tout
Pouvez vous m'expliquer un peu plus le code?

 

[AlexandreLEGRAND]

Re : Optinisation d'une copie

Bonsoir à tous


Test OK avec ta nouvelle PC avec cette macro pas forcément de la plus belle facture, mais simplement basiquement fonctionnelle.

Sub Copie()
Dim dl& 'déclaration variable
Application.ScreenUpdating = False 'on fige le rafraichissement écran
dl = Sheets(1).Cells(Rows.Count, "A").End(3).Row - 4 'on identife le nombre de lignes des tableaux
Sheets(1).Range(Split([nom].Address, ",")(0)).Resize(dl).Copy 'on copie le premier tableau
With [Tab_nom]
    .PasteSpecial Paste:=xlPasteAll, Transpose:=True 'on le transpose
    Sheets(1).Range(Split([nom].Address, ",")(1)).Resize(dl).Copy ' on copie le second tableau
    .End(xlDown)(2).PasteSpecial Paste:=xlPasteAll, Transpose:=True ' on le transpose à la suite
    .CurrentRegion.HorizontalAlignment = xlCenter 'on aligne le contenu horizontalement au centre
End With
Application.Goto [Tab_nom] 'on sélectionne Tab_nom
Application.CutCopyMode = False 'on vide le ClipBoard (Presse-papier)
Application.ScreenUpdating = True 'on défige le rafraichissement
End Sub

NB: On utilise Split et .Address pour déterminer l'adresse des cellules des deux "tableaux".

Superbe!
Hélas, si le tableau n'est pas en continu ça bloque ('erreur 400')
Dans mon document personnel, je tente d'assigner les noms en fonction d'une liste de choix au dessus...
Je joins mon fichier test dans un nouveau fil de discussion.