VBA qui se répète pour chaque cellule de la plage

Bonjour !

Dans le cadre de mon emploi, j'ai besoin de créer un document à 2 feuilles. La première, c'est l'inventaire des produits, la deuxième, c'est le "takeOff" qu'on appelle, donc le formulaire de commande final.

Dans feuille "Inventaire", dans la première colonne; les images de produits

dans la deuxième colonne; les numéros de produits

de la 3e à la 14e colonne, les formats disponibles

dans la 15e colonne. un espace pour les notes (masquer dans cette feuille, mais qui doit être copier dans le takeoff).

Dans la feuille "TakeOff", dans la première colonne; les images qui seront coller

dans la deuxième colonne; les numéros de produits qui seront coller

dans la 3e colonne, le format correspondant au choix qui sera coller

dans la 4e colonne, les notes (cacher dans la feuille "Inventaire" qui apparaiteront là.

Alors, j'ai déjà "pondu" le code à l'aide de recherche pour que, quand j'appuie sur le bouton et que la cellule c3 <= 0 (donc quand elle n'est pas vide), l'image, le numéro et le format correspondant soit transférés dans la feuille "TakeOff"

Mon problème; j'aimerais cette procédure pour chaque cellule de la plage c3:m146, en appuyant sur un seul bouton. Il doit y avoir quelque chose à faire avec les boucles, non ? ..

Pouvez-vous m'aider ?

S.V.P. !!

Sub macro1()

Dim verif As Range
Set verif = Cells(3, 3)

'si la cellule de "verif" =0 (si vide), alors
If Application.Sum(verif) = 0 Then
'rien

'Sinon (si elle est pas vide)
Else
    'sélectionner l'image et le #
    Range("a3:b3").Select
    'copier
    Selection.Copy
    'Activer la feuille "TakeOff"
    Sheets("TakeOff").Select
    'Sélectionner la première ligne vide (fin du tableau)
    Range("b50000").End(xlUp).Offset(1, -1).Select
    'copier l'information
    ActiveSheet.Paste
    'activer la feuille "inventaire"
    Sheets("Inventaire").Select
    'sélectionner la grandeur correspondante
    Range("c2").Select
    'copier
    Selection.Copy
    'Activer la feuille "TakeOff"
    Sheets("TakeOff").Select
     'Sélectionner la première ligne vide (fin du tableau)
    Range("c50000").End(xlUp).Offset(1, 0).Select
    'copier
     ActiveSheet.Paste
End If
End Sub

Ah aussi, j'ai vu quelqu'un sur un forum dire qu'on pouvait supprimer les "Selects", j'ai essayée, mais sa me fait un erreur. Voici ce que j'ai essayé:

  Sheets("TakeOff").Select.Range("b50000").End(xlUp).Offset(1, -1).Paste

'au lieu de

    Sheets("TakeOff").Select
    'Sélectionner la première ligne vide (fin du tableau)
    Range("b50000").End(xlUp).Offset(1, -1).Select
    'copier l'information
    ActiveSheet.Paste

Bonsoir

un fichier joint à essayer :

Si sur la ligne il n'y a aucun "1" alors on passe à la ligne suivante...

@ bientôt

LouReeD

Wow !!!

Merci LouReeD pour ta réponse rapide !

Est-ce possible de chercher plusieurs valeurs en même temps, exemple valeur_cherchee = "1" ou "2" ou "3" ?

J'ai essayée cette façon et... bug

Aussi, l'image de la colonne A dans "inventaire" n'est pas tranférer dans la feuille "TakeOff"

Merci

Bonsoir,

chez moi pas d'image...

Sinon, si la valeur à chercher est "toujours" différente, alors on peut faire appel à mon Joker...

MFerrand !

Si ça ne tient qu'à moi, je le ferais en deux temps :

le premier on simule un somme(C3:M3), qui serait égal à 5, car dans un des formats il y a un 5.

Puis on transfert ce 5 en valeurcherchée pour le find afin de connaître le numéro de colonne...

Un peu lourd non ?

@ bientôt

LouReeD

En fait pas si lourd que cela !!!

Attention ceci fonctionne si et seulement si une seule valeur par ligne !

@ bientôt

LouReeD

Ah super !

Probablement que j'en demande beaucoup, mais il n'y a vraiment pas de solution pour le cas où il y aurait plusieurs valeurs qui peuvent être différentes et sur la même ligne ?

Merci !

Bonsoir,

sans information de votre part je suis parti du principe que s'il y a plusieurs formats alors on crée autant de lignes que de formats :

@ bientôt

LouReeD

Merci Beaucoup !!!!!!!!!

Ça fonctionne à merveille !

Il ne me reste qu'un petit problème de mise en page;

Quand la feuille TakeOff est plus longue qu'une page, ma zone d'impression ne s'ajuste pas automatiquement (j'peux bien rêver ! )

Y'a-t-il quelque chose à faire pour que la zone s'agrandisse à mesure, et pour qu'elle diminue (seulement en longueur) lorsque j'éfface ?

Bonsoir...

En fait il faudrait savoir à combien de ligne "total" du tableau il y a changement de feuille, à ce moment là dans le code on insère des sauts de page...

Sinon en mise en page vous mettez "agrandir ou réduire pour tenir dans une page en hauteur et une page en largeur"...

@ bientôt

LouReeD

Merci !!!

J,ai trouvé cette formule qui fonctionne pour moi:

    derline = Range("e65536").End(xlUp).Row
    ActiveSheet.PageSetup.PrintArea = "A1:g" & derline

Merci infiniment pour toutes vos réponses !

À la prochaine !

Bonsoir et merci de vos merci !!!

@ (très) bientôt

LouReeD