VBA - Copie de cellules sous conditions avec un tableau de données variable

Bonjour la communauté,

Je commence tout juste à me dépatouiller sur du VBA avec une minuscule expérience en programmation et je bute férocement sur un code.

En PJ le fichier en question qui est issu d'un export d'un automate de laboratoire qui a déjà subit quelques lignes de codes.

Ce que je souhaite : Transférer le contenu des cellules de la feuille "Données" vers une cellule de la feuille "Transfert_ICP" selon le principe suivant : un numéro d'échantillon (colonne A - SampleId) peut avoir 1, 2 ou 3 valeurs (colonnes B,C et D). Ce sont ces valeurs (qui sont des numéros de capsules de pesées de cet échantillon pour situer le contexte) qui doivent être basculées vers l'autre feuille en face de leur numéro d'échantillons correspondant.

Dans le fichier, j'ai mis des couleurs aux cases pour mieux matérialiser mon propos.

Bien sur, il peut y avoir plus que 3 échantillons qui ont 1, 2 ou 3 capsules. Autrement, je ne vous aurais pas embêté !

Pour réaliser cette opération grandiose ( :p ), j'ai écrit ça dans VBA en essayant de me rappeler mes souvenirs ancestraux d'algo et des cours de ce site :

Sub Transfert_caps()

Dim NumL As Integer, NumC As Integer

NumL = 2
NumC = 2

While Sheets("Données").Cells(NumL, 1) <> "" And Sheets("Données").Cells(1, NumC).Value <> ""
        If Sheets("Données").Cells(NumL, 1).Value = Sheets("Transfert_ICP").Cells(NumL, 1).Value Then
         Sheets("Transfert_ICP").Cells(NumL, 2).Value = Sheets("Données").Cells(NumL, NumC).Value
         NumC = NumC + 1

        Else

        NumL = NumL + 1

        End If
Wend

End Sub

Alors non seulement il ne copie pas la bonne première cellule, mais en plus il ne poursuit pas la boucle.

Erreur de syntaxe ou de logique dans l'algorithme ? Je réfléchit dessus depuis ce matin mais je m'embrouille l'esprit.

Merci d'avance si quelqu'un a une idée du problème.

Bonne fin de journée.

Salut Shamux,

code à copier-coller dans le module de 'Données'.

La macro démarre via un double-clic en [A1].

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
Dim tData1, tData2()
Cancel = True
'
If Not Intersect(Target, Range("A1")) Is Nothing Then
    iRow = Range("A" & Rows.Count).End(xlUp).Row
    tData1 = Range("A2:D" & iRow).Value
    For x = 1 To UBound(tData1, 1)
        For y = 2 To 4
            If tData1(x, y) > 0 Then
                iIdx = iIdx + 1
                ReDim Preserve tData2(4, iIdx)
                tData2(0, iIdx - 1) = tData1(x, 1)
                tData2(1, iIdx - 1) = tData1(x, y)
                tData2(3, iIdx - 1) = tData1(x, 1) & "-*"
            End If
        Next
    Next
    With Worksheets("Transfert_ICP")
        iRow = .Range("A" & Rows.Count).End(xlUp).Row
        If iRow > 1 Then .Range("A2:F" & iRow).ClearContents
        .Range("A2").Resize(iIdx, 4) = WorksheetFunction.Transpose(tData2)
        .Activate
    End With
End If
'
End Sub

Tu arriveras bien à compléter les données du tableau tData2 à afficher !? Oui, non?

A+

Salut Curulis !

Merci de ta réponse, je n'avais pas penser aux tableaux sous vba (ni même tout court d'ailleurs ). Du coup, ne comprenant rien à ce que tu avais fait, j'ai couru vers le cours dans ce même site et miracle ! J'ai compris.

J'ai adapter ce code à ma macro générale et ça marche parfaitement.

Encore merci d'avoir pris le temps de me répondre.

Shamux