recuperer des donnees En double cliquant sur une cellule

[BIL boud]

Bonjour



jai mis un code (a laide de monsieur "ODVJ" ) qui récupère des chifre a partir de bases de donnes (dans la cellule AO de chaque feuille) et apres les positionnent dans mon tableau de synthese (qui est sur la photo)


et la je souhaiterais a partir de ma feuilles de synthese (celle qui apparaît sur la photo ) en double cliquant sur une cellule le code va chercher dans tt mes feuilles les ligne de (A :F)

je ne sais pas comment proceder

exemple

1234

Q correspond tjrs au premier chifre (dasn ce cas Q=1)
P correspond au 2 eme chifre (dasn ce cas p=2)
D correspond au 3 eme chifre (dasn ce cas D=3)
C correspond au 4 eme chifre (dasn ce cas C=4)

double clique sur b2 si le premier chifre dans la colonne AO =1
le code recupere les colonne (A:F) de la ligne concernee ( si range("a1") de chque feuille = range(a1) de la photo)

double clique sur b3 si le premier chifre dans la colonne AO =2
le code recupere les colonne (A:F) de la ligne concernee ( si range("a1") de chque feuille = range(a1) de la photo)

double clique sur b4 si le premier chifre dans la colonne AO =3
le code recupere les colonne (A:F) de la ligne concernee ( si range("a1") de chque feuille = range(a1) de la photo)
.
.
.
.

veuillez trouve sur le lien mon fichier de ravail, c plus simple

https://www.cjoint.com/c/IDllW6o2MOY

 

[BIL boud]

voici le lien pour reuperer le fichie excel
https://www.cjoint.com/c/IDllW6o2MOY

 

[BIL boud]

jai modifie le code de ODVJ mais a chaque fois les lignes s'ecrasent
par exemple si jai des donnee dans la ligne 2 de ma premiere feuille et des donnée dans la ligne 2 de ma 2 eme feuille , je vais avoir sur ma feuille de synthese les données de la ligne 2 de ma feuille 2 ( ecrasement de la ligne 2 de F1 par F2)

le 2 eme probleme pour :
'Q : ca marche bien
mais pour les autres , C,D,P a chque jai une ligne qui saffiche mm si elle respecte pas les conditions

voici le code

Sub nnnn()



Dim a, b(4) As Integer, i As Integer, f As Integer, m As Integer, L As Integer



Columns("H:M").ClearContents



a = Worksheets("NEW_VB_config").Range("o2:o12") 'nom des 11 feuilles

For i = 2 To 100

For L = 1 To 6

For f = 1 To 11 'boucle sur les feuilles

If a(f, 1) <> "" Then

With Worksheets(a(f, 1))

If .Range("ao" & i).Value <> "" And .Range("a" & i).Value = ActiveSheet.Range("a1").Value Then

For m = 1 To 4

b(m) = Mid(.Range("ao" & i), m, 1)





' Q

If ActiveCell.Activate Then

If ActiveCell.Row = 2 And ActiveCell.Column = 2 And .Range("a" & i).Value = ActiveSheet.Range("a1").Value And b(1) = 1 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 3 And ActiveCell.Column = 2 And b(1) = 2 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 4 And ActiveCell.Column = 2 And b(1) = 3 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 5 And ActiveCell.Column = 2 And b(1) = 4 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)



'C

ElseIf ActiveCell.Row = 2 And ActiveCell.Column = 3 And b(2) = 1 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 3 And ActiveCell.Column = 3 And b(2) = 2 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 4 And ActiveCell.Column = 3 And b(2) = 3 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 5 And ActiveCell.Column = 3 And b(2) = 4 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)



'D

ElseIf ActiveCell.Row = 2 And ActiveCell.Column = 4 And b(3) = 1 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 3 And ActiveCell.Column = 4 And b(3) = 2 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 4 And ActiveCell.Column = 4 And b(3) = 3 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 5 And ActiveCell.Column = 4 And b(3) = 4 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)



'P

ElseIf ActiveCell.Row = 2 And ActiveCell.Column = 5 And b(4) = 1 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 3 And ActiveCell.Column = 5 And b(4) = 2 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 4 And ActiveCell.Column = 5 And b(4) = 3 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

ElseIf ActiveCell.Row = 5 And ActiveCell.Column = 5 And b(4) = 4 Then

ActiveSheet.Cells(i, L + 7) = .Cells(i, L)

End If



End If



Next m

End If

End With

End If

Next f

Next L

Next i


End Sub