Macro pour copier des données en fonction d'une donnée....

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Christian0258

XLDnaute Accro
Bonjour à tout le forum,

Je souhaiterais, à nouveau, votre aide pour écrire une macro...
pas facile à expliquer...idem pour rédiger l'intitulé...Lol

voir fichier joint.

Merci pour votre aide si précieuse.

Bien amicalement,
Christian
 

Pièces jointes

Re : Macro pour copier des données en fonction d'une donnée....

Bonjour Christian,

D'abord une solution par formule matricielle en B5 :

Code:
=INDEX('Base Plats'!B:B;PETITE.VALEUR(SI(NB.SI(F$5:G$124;'Base Plats'!B$1:$B108);LIGNE('Base Plats'!B$1:$B108));LIGNES(B$5:B5)))
A valider par Ctrl+Maj+Entrée et à tirer jusqu'à la ligne 4 + 106 = 110.

Fichier joint.

Bien entendu tu peux masquer les valeurs d'erreur soit par MFC soit par SIERREUR :

Code:
=SIERREUR(INDEX('Base Plats'!B:B;PETITE.VALEUR(SI(NB.SI(F$5:G$124;'Base Plats'!B$1:$B108);LIGNE('Base Plats'!B$1:$B108));LIGNES(B$5:B5)));"")
A+
 

Pièces jointes

Re : Macro pour copier des données en fonction d'une donnée....

Re,

Maintenant une solution VBA :

Code:
Private Sub Worksheet_Activate()
Worksheet_Change [F5] 'cellule à adapter
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim P As Range, t, rest$(), i&, n&
Set P = [F5:G124] 'plage à adapter
If Intersect(Target, P) Is Nothing Then Exit Sub
t = Feuil2.[B3:B108] 'CodeName + plage à adapter
ReDim rest(1 To UBound(t), 1 To 1)
For i = 1 To UBound(t)
  If Application.CountIf(P, t(i, 1)) Then
    n = n + 1
    rest(n, 1) = t(i, 1)
  End If
Next
[B5].Resize(UBound(rest)) = rest
End Sub
Fichier joint.

A+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
295
Réponses
40
Affichages
2 K
Retour