remplir ligne sous condition

[chris34190]

bonjour tout le monde.
Je cherche a remplir les cases B1 à I1 sur les feuilles 1 et 2, avec les valeurs de la feuille "port" qui correspond au n° de département de la page 1. Pas sur que ce soit clair ^^
Il se peut que j'ai besoin de plus de feuilles : de 1 à 14.
si vous avez une solution ?
Par avance merci

 

[job75]

Bonsoir chris34190,

Avec cette macro on peut renseigner jusqu'à 14 feuilles nommées Feuil1 Feuil2... Feuil14 :

Sub Transfert()
Dim source As Worksheet, i As Variant, n As Byte
Set source = Sheets("port")
i = Application.Match(Sheets("page 1").[F3], source.[A:A], 0)
If IsNumeric(i) Then
    On Error Resume Next 'si des feuilles n'existent pas
    For n = 1 To 14 'pour 14 feuilles
        Sheets("Feuil" & n).[B1:J1] = source.Cells(i, 2).Resize(, 9).Value
    Next
End If
End Sub

Mais pourquoi entrer les mêmes valeurs dans 14 feuilles ???

A+

 

[chris34190]

Le but est de selectionner le département de livraison, et de l'appliquer a plusieurs feuilles pour calculer mes tarifs.
j'ai essayer d'appliquer la formule, mais ça ne marche pas.

 

[job75]

j'ai essayer d'appliquer la formule, mais ça ne marche pas.

Persévérez !

 

[chris34190]

Bon j'ai réussi (le touche "lecture" ^^). Par contre je dois impérativement appeler les feuilles : "feuil1, feuil2 ..." est-il possible de modifier la formule pour nommer les feuille comme on le veut ?
De plus, est-il possible de valider la saisie sans passer par Alt + F8 ?

 

[job75]

Bonjour chris34190, le forum,

est-il possible de modifier la formule pour nommer les feuille comme on le veut ?

En mettant dans un tableau (Array) les noms des feuilles :

Sub Transfert()
Dim liste, source As Worksheet, i As Variant, n As Byte
liste = Array("tata", "titi", "toto", "tutu") 'liste des feuilles à renseigner, à adapter
Set source = Sheets("port")
i = Application.Match(Sheets("page 1").[F3], source.[A:A], 0)
If IsNumeric(i) Then
    On Error Resume Next 'si des feuilles n'existent pas
    For n = 0 To UBound(liste)
        Sheets(liste(n)).[B1:J1] = source.Cells(i, 2).Resize(, 9).Value
    Next
End If
End Sub

Dans le fichier joint la macro se lance par un bouton.

Bonne journée.

 

[job75]

Autre solution dans ce fichier (2), traiter toutes les feuilles sauf "page 1" et "port" :

Sub Transfert()
Dim source As Worksheet, i As Variant, w As Worksheet
Set source = Sheets("port")
i = Application.Match(Sheets("page 1").[F3], source.[A:A], 0)
If IsNumeric(i) Then
    For Each w In Worksheets
        If LCase(w.Name) <> "page 1" And LCase(w.Name) <> "port" Then _
            w.[B1:J1] = source.Cells(i, 2).Resize(, 9).Value
    Next
End If
End Sub

LCase permet d'ignorer la casse.

 

[job75]

Fichier (2 bis) avec dans le code de la feuille "page 1" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [F3]) Is Nothing Then Transfert
End Sub

Plus besoin de bouton pour lancer la macro.

 

[chris34190]

C'est tout a fait ce qu'il me faut. C'est fou ce qu'il est possible de faire 🙂
Merci beaucoup 🙂

 

[chris34190]

Bonjour et bonne année
J'ai l'impression que la macro ne s'execute plus sur mon fichier. J'ai peut-être fait une mauvaise manip. Est-il possible de relancer la procédure ?

 

[job75]

Bonsoir chris34190,

J'ai l'impression

On interviendra quand ce ne sera plus une impression mais une certitude et que le fichier défectueux sera joint.

A+

 

[chris34190]

Bonsoir chris34190,

On interviendra quand ce ne sera plus une impression mais une certitude et que le fichier défectueux sera joint.

A+

Bonjour
Qui cherche trouve (enfin ce coup-ci)
J'avais tout simplement rajouté quelques lignes sans immaginer que la macro n'en tiendrai pas compte.
Quand on n'est pas formé à cet outil, ben on n'a pas les bons réflexes...
Mon erreur aidera peut être d'autres utilisateurs 🙂

 

[job75]

Mon erreur aidera peut être d'autres utilisateurs 🙂

Peut-être mais pour ça il faudrait savoir quelles sont ces "quelques lignes" rajoutées !!!