Détente pour vous...casse tête pour moi

Question

bonjour

je voudrais d'une prog de copie, pour linstant ca peu me dépanner

je vais commencer à la ligne 7 (numérotation XL)

Sur la feuille "Stock" copier I7 J7 K7 L7 N7 P7 et les coller Feuille "0001" en B2 G2 E2 J2 J3 J4.

ensuite Feuille "Stock" copier I8 J8 K8 L8 N8 P8 et les coller feuille "0002" en B2 G2 E2 J2 J3 J4

pour copier, incrémenter les ligne de 1... pour coller les cellule reste les meme mais les feuilles sont à incrémenter de 1 sachant qu'elle sont numérotée de 0001 à 0300

je pense que ca doit pas etre trop compliqué mais pour moi cest un vrai casse tête taïwané ^^

merci de votre aide
Jacky

cs_Jack · Answer

Salut
C'est simple : Tu enregistres une macro pendant que tu fais l'opération à la main pour un groupe de données, tel que tu l'as décrit : Tu auras ainsi le code.

Il ne te restera qu'à modifier cette syntaxe pour intégrer une variable qui désignera le numéro de la ligne --> Voir For-Next

Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Jacky1002 · Answer

voilà jai réussi qqch mais cest une (passer moi lexpression) PUTAIN D'USINE A GAZ ^^


Sub copy()
For x = 1 To 9
Sheets("Stock").Range("I" & x + 6).copy
Sheets("000" & x).Range("B2").PasteSpecial xlPasteValues, , , True
Next

For x = 1 To 9
Sheets("Stock").Range("J" & x + 6).copy
Sheets("000" & x).Range("G2").PasteSpecial xlPasteValues, , , True
Next

For x = 1 To 9
Sheets("Stock").Range("K" & x + 6).copy
Sheets("000" & x).Range("E2").PasteSpecial xlPasteValues, , , True
Next

For x = 1 To 9
Sheets("Stock").Range("L" & x + 6).copy
Sheets("000" & x).Range("J2").PasteSpecial xlPasteValues, , , True
Next

For x = 1 To 9
Sheets("Stock").Range("N" & x + 6).copy
Sheets("000" & x).Range("J3").PasteSpecial xlPasteValues, , , True
Next

For x = 1 To 9
Sheets("Stock").Range("P" & x + 6).copy
Sheets("000" & x).Range("J4").PasteSpecial xlPasteValues, , , True
Next
End Sub

J'ai bien essayer de simplifier mais la syntaxe est pas bonne et avec les truc genre I&x+6 je m'emmêle les pinceaux avec les guillemet les virgule bref quand je simplifie ca donne ça :

Sub copy()
For x = 1 To 9
Sheets("Stock").Range("I & x + 6", "J & x + 6", "K & x + 6", "L & x + 6", "N & x + 6", "P & x + 6").copy
Sheets("000" & x).Range("B2", "G2", "E2", "J2", "J3", "J4").PasteSpecial xlPasteValues, , , True
Next
End Sub


Ca marche pas... mais ou est ce que je me plante? comment syntaxer cela??
Merci
Jacky

Jacky1002 · Answer

de plus ec programme est trop long à s'exécuter

moyen de faire plus rapide??

Jacky

c148270 · Answer

Bonjour
Il est possible de gagner du temps en evitant l'affichage du classeur

    ActiveWindow.WindowState = xlMinimized
puis en l'affichant à la fin
    ActiveWindow.WindowState = xlMaximized

Pour le code il est possible de faire des boucles en utilisant l'écriture suivante
Sheets("Stock").Range(cells(ligne,colonne),cells(ligne,colonne)).copy

bonne journée

cs_Jack · Answer

Re
Non, tu n'as pas le choix car, même si tu peux faire un Select d'un ensemble de cellules non consécutives comme par exemple :
Range("B3:C3,B8:C8,B14:C14,B18:C18").Select
tu ne pourras coller ces cellules QUE dans un ensemble de cellules consécutives, pas vers un panachage de Ranges.

Si tes cellules de destinations avaient été 'calculables', oui, on aurait pu s'y adresser plus globalement, mais la suite B2-G2-E2-J2-J3-J4 n'a pas de suite logique.

Le mieux que j'aie trouvé :
Créer une Sub qui s'occupe des transferts :
Sub Transfert(sFrom As String, sTo As String)
    Dim x As Long
    For x = 1 To 9
        Sheets("Stock").Range(sFrom & x + 6).Copy
        Sheets("000" & x).Range(sTo).PasteSpecial xlPasteValues, , , True
    Next
End Sub
Et la lancer à tour de rôle avec chaque couple :
    Application.Calculation = xlManual  ' Mise en pause des recalculs
    Call Transfert("J", "G2")
    Call Transfert("K", "E2")
    Call Transfert("L", "J2")
    Call Transfert("N", "J3")
    Call Transfert("P", "J4")
    Application.Calculation = xlAutomatic  ' Repasse en recalculs auto
    Calculate   ' et demande un reclacul
    Mais cela ne changera surement pas grand chose au temps d'exécution, je pense.

Ce temps d'exécution est peut-être altéré par le fait que tu changes souvent de feuille (9 fois par transfert) : Il faudrait peut-être réimaginer les boucles dans l'autre sens :
Dans la partie déclaration de ta page de code :
Private Type typeCoordonnées
    RangeSource     As String
    RangeCible      As String
End Type
Dans ta page de code :
Sub maFonctionPerso()

    Dim aCoordonnées(1 To 5) As typeCoordonnées
    Dim x As Long
    Dim r As Long
    
    aCoordonnées(1).RangeSource = "J"
    aCoordonnées(1).RangeCible = "G2"
    aCoordonnées(2).RangeSource = "K"
    aCoordonnées(2).RangeCible = "E2"
    aCoordonnées(3).RangeSource = "L"
    aCoordonnées(3).RangeCible = "J2"
    aCoordonnées(4).RangeSource = "N"
    aCoordonnées(4).RangeCible = "J3"
    aCoordonnées(5).RangeSource = "P"
    aCoordonnées(5).RangeCible = "J4"

    For x = 1 To 9
        For r = 1 To 5
            Sheets("Stock").Range(aCoordonnées(r).RangeSource & x + 6).Copy
            Sheets("000" & x).Range(aCoordonnées(r).RangeCible).PasteSpecial xlPasteValues, , , True
        Next r
    Next x

End Sub
Vala
Jack, MVP VB
NB : Je ne répondrai pas aux messages privés

Le savoir est la seule matière qui s'accroit quand on la partage (Socrate)

Jacky1002 · Answer

scuze moi mais qu'apel tu "partie déclaration" où je dois mettre : 


Private Type typeCoordonnées
    RangeSource     As String
    RangeCible      As String
End Type

je lai mis dans un module à pars j'ai meme essayer dans le worbook ^^
quand je le met avant le Sub il me le met à la suite du précédent et ma le sépare du sub sur lequel il doit agir..

merci 
jacky

Jacky1002 · Answer

cest bon j'ai réussi

merci je tetre penché sur mon pb 
malheureusement je suis au regrès de t'annoncer que ton code est encore plus long à éxécuter jai cru que jallai devoir rebooter le PC ^^

"le savoir est la seul matière qui s'accroit quand on la partage" la preuve est faite ^^

merci d'avoir essayé
cordialement 
Jacky

Jacky1002 · Answer

au fait je pense a ça je disais au dessus que jai devoir rebooter 
comment arrété un code qui tourne quand l'affichage de l'écran galère et qu'on ne peu pas accéder au bouton pause au stop???

c148270 · Answer

Il me semble que c'est control/pause et non pause.
Sinon arrêt "sauvage" : ctrl/alt/supp et tuer l'appli

Détente pour vous...casse tête pour moi

9 réponses

Votre réponse

Discussions similaires