remplir ligne sous condition

chris34190

XLDnaute Nouveau
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
 

Pièces jointes

  • test departement.xlsx
    10.6 KB · Affichages: 11

job75

XLDnaute Barbatruc
Bonsoir chris34190,

Avec cette macro on peut renseigner jusqu'à 14 feuilles nommées Feuil1 Feuil2... Feuil14 :
VB:
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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 :
VB:
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.
 

Pièces jointes

  • test departement(1).xlsm
    26.4 KB · Affichages: 8

job75

XLDnaute Barbatruc
Autre solution dans ce fichier (2), traiter toutes les feuilles sauf "page 1" et "port" :
VB:
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.
 

Pièces jointes

  • test departement(2).xlsm
    25.9 KB · Affichages: 10

job75

XLDnaute Barbatruc
Fichier (2 bis) avec dans le code de la feuille "page 1" (clic droit sur l'onglet et Visualiser le code) :
VB:
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.
 

Pièces jointes

  • test departement(2 bis).xlsm
    27.1 KB · Affichages: 13

chris34190

XLDnaute Nouveau
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 :)
 

Discussions similaires

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof