XL 2019 question macro excel copier collé

[zhennya]

Bonjour,

Je viens vers vous pour une question sur les macros.

j'ai un tableau d'expédition où je dois sortir les produits qui sont expédiés et les coller sur leur page de stock j'ai créé une macro qui fonctionne mais je ne trouve pas un moyen de la raccourcir.

Pouvez-vous m'aider ?

Merci

Voici ce que j'ai fais je voudrais raccourcir les macro z car j'ai 89 cellules à vérifier et cela prendre trop de temps de copier à chaque fois )
Sub expédition()
Sheets("expédition").Select
ActiveSheet.ShowDataForm
Range("a1:g89").Select
Selection.Copy
Range("a92").Select
ActiveSheet.Paste
sup_ligne_vide
z_1
z_2
z_3




Sub z_2()
If Range("B92") = "Carbonade" Then
Range("a92:e92").Select
Selection.Copy
Sheets("carbonade stock").Select
Range("f4").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Range("B93") = "Carbonade" Then
Range("a93:e93").Select
Selection.Copy
Sheets("carbonade stock").Select
Range("F4").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
End If
If Range("B94") = "Carbonade" Then
Range("a94:e94").Select
Selection.Copy
Sheets("carbonade stock").Select
Range("f4").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
If Range("B95") = "Carbonade" Then
Range("a95:e95").Select
Selection.Copy
Sheets("carbonade stock").Select
Range("F4").Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
End If
End Sub

 

[zhennya]

up

 

[herve62]

Bonsoir
Une boucle ça ne va pas ?
style for each ...ou encore
tout simple
For x = 93 to 180 (à ajuster)
if cells(x, 2)= "Carbonade" Then
Range("a" & x & ":e" & x).Select
...le reste de ton code
next x
non ?
reste peut être aussi à inhiber l'affichage
en mettant au début
application.ScreenUpdating= false
puis remettre à true à la fin de la Sub
Généralement une macro comme ça ne met pas plus de 5sec.

 

[Phil69970]

Bonjour @zhennya , Hervé, le forum

Généralement une macro comme ça ne met pas plus de 5sec.

Hervé tu es pessimiste ou tu as un ordi de l'age de pierre

j'ai 89 cellules à vérifier et cela prendre trop de temps de copier à chaque fois )

Pour vérifier 89 cellules et les copier si besoin je ne suis pas sur que l'on dépasse la seconde !!!

@zhennya : Avec un fichier anonymisé on pourrait voir la totalité de ton code et l'alléger....

@Phil69970

 

[zhennya]

bonjour,

désolé de ma réponse tardive je n'avais pas mon pc
merci de vos réponses, Herve je n'arrive pas à faire fonctionné même avec la boucle il me donne une erreur je vous envoie un fichier simplifier pour vous montrer le code (le code de z_13 n'est pas complet car il faudrait copier collé pour tester jusqu'à la cellule b180) je voudrait trouver un code qui me raccourcie la macro z_13 .

merci pour votre aide @herve62 et @Phil69970

 

[Phil69970]

@zhennya

Justement c'est la totalité du code qu'il nous faudrait......

le code de z_13 n'est pas complet

@Phil69970

 

[zhennya]

@zhennya

Justement c'est la totalité du code qu'il nous faudrait......


@Phil69970

le code reste le même juste les cellule qui change il vont de 91 à 180

 

[zhennya]

le code reste le même juste les cellule qui change il vont de 91 à 180

pour le moment j'ai fait ça avec les aide du forum
Dim x As Integer

For x = 180 To 90 Step -1

If Cells(x, 2) = "produit 1" Then
Range("a" & x & ":e" & x).Select
Selection.Copy
Sheets("produit 1 stock").Select
[f4].Select
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Next

End Sub



mais il s'arrête au 1er produit 1 qu'il rencontre je voudrait qu'il continue voir si il y en a d'autre.

 

[Phil69970]

@zhennya

Décidément j'ai du mal à me faire comprendre :

Justement c'est la totalité du code qu'il nous faudrait......

En clair voulez vous nous donnez le code dans son intégralité et non retouché et avec les bonnes adresses de cellules, nom des onglets etc.... ?

@Phil69970

 

[zhennya]

@zhennya

Décidément j'ai du mal à me faire comprendre :

En clair voulez vous nous donnez le code dans son intégralité et non retouché et avec les bonnes adresses de cellules, nom des onglets etc.... ?

@Phil69970

je n'est pas écrit la totalité du code car je cherche a écrire un code plus court pour ne pas à avoir, à recopier 90 fois le même code des cellules b91 à b180. je ne sais pas si vous me comprenez.

 

[herve62]

Bonjour
@Phil69970 : j'ai écris 5sec comme on dit t'as pas 2min ..... c'est peut être 1 comme 5
Sinon oui ! explique ce que tu veux comparer ( le IF du produit ) c'est OU ?? quelle feuille , cezllule?
TU copies quoi et OU ??
Là j'ai juste fait pour que tu vois la structure ; Ajuste ta boucle ou j'ai marqué donc x=91 to 180

 

[Phil69970]

@zhennya
Bonjour Hervé

Nous en sommes au 5 ou 6eme messages avec la même demande donc si tu veux pas le donner c'est ton choix.

En clair voulez vous nous donnez le code dans son intégralité et non retouché et avec les bonnes adresses de cellules, nom des onglets etc.... ?

@Phil69970

 

[zhennya]

Bonjour
@Phil69970 : j'ai écris 5sec comme on dit t'as pas 2min ..... c'est peut être 1 comme 5
Sinon oui ! explique ce que tu veux comparer ( le IF du produit ) c'est OU ?? quelle feuille , cezllule?
TU copies quoi et OU ??
Là j'ai juste fait pour que tu vois la structure ; Ajuste ta boucle ou j'ai marqué donc x=91 to 180

je voudrait que la macro vérifie dans le tableau a91:e180 la colonne b si b = le nom du produit
si exemple on cherche le produit 1
si b3= produit 1 copier A3:E3 vers "produit 1 stock"
et il continue voir si d'autre cellule b = produit 1

pour le moment il me copie que que le premier s il y en a plusieurs il ne continue pas

 

[zhennya]

merci de votre aide j'ai réussi à trouver la solution

Sub expédition()
Sheets("expédition").Select 'selection de la feuille
ActiveSheet.ShowDataForm ' ouverture d'aide à la saisie
Range("a1:g89").Select 'selection de la plage de donné
Selection.Copy 'copier
Range("a92").Select ' sélection cellule
ActiveSheet.Paste ' coller les donnes
sup_ligne_vide ' macro suppression ligne vide
z_1 ' macro verif/collage dans la feuille
z_2 ' macro verif/collage dans la feuille
z_3 ' macro verif/collage dans la feuille




Sub z_1()
Dim x As Integer ' intégration de x
For x = 90 To 180 Step 1 ' x va de 90 à 180 avec un pas de 1

If Cells(x, 6) = "3" Then ' si Fx = 3
Range("a" & x & ":e" & x).Select ' sélection Ax : Ex
Selection.Copy ' copier la selection
Sheets("produit 1 stock").Select 'sélection feuille ou coller
[f4].Select 'sélection cellule ou coller
Selection.End(xlDown).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False ' fonction pour coller en dessous
Sheets("expédition").Select ' on revient à expédition
End If ' fin du si

Next x 'on continue les x
End Sub 'fin de la macro


Sub sup_ligne_vide()

Dim Ligne As Integer
For Ligne = 180 To 91 Step -1

If IsEmpty(Range("d" & Ligne)) Then 'si cellule = vide
Rows(Ligne).Delete 'Effacer la ligne
End If

Next Ligne 'ligne suivante

End Sub

 

[herve62]

Bonsoir
En fait tu n'as fait qu'à ta tête puisque déjà tu supprimes mon "with worksheets .." qui permet d'être sûr
de la feuille de travail , ensuite le "FOR" avec step 1 ..? inutile c'est toujours 1 de base et enfin on ne voit plus le nom du produit dans le IF
Ensuite on m'a toujours appris au début , qu'en Vba il faut éviter tous les SELECT , COPY , PASTE
d'ailleurs dans ma Sub j'en avais supprimé ....cause ERREUR !
Donc bonne continuation .........