XL 2016 Information de cellule contiguë a déplacer dans une compilation

[My<3]

Bonjour a tous, je cherche depuis plusieurs heure sans trop de succès alors je pose ma question ici.

J'ai besoin de rapporter les informations d'une feuille a une autre, j'ai trouvé une formule qui repousse l'information des cellules contiguës vers ma feuille de compilation mais le hic,

j'aimerais que chaque onglet ailles sa propre ligne de transcription de donnés

Sub transfert_donnée()
Dim tableau, Derlig&
With ActiveSheet
'remplacer 1 par l'index ou le nom de la sheets source
tableau = Array(.[c3], .[F3], .[I3], .[A12], .[A15], .[j18])
End With

With Sheets(1) 'remplacer 2 par l'index ou le nom du sheets de destination
Derlig = .Cells(Rows.Count, "B").End(xlUp).Row + 1
.Cells(Derlig, "B").Resize(, UBound(tableau) + 1) = tableau
End With
End Sub

Donc mon problème est la second partie de la formule, est-ce que quelqu'un peu aider avec ceci?
Ce que je voudrais c'est que les case de la feuille exemple 001 se transcrive dans sur la ligne 10 de ma feuille de compilation. Les cellules C3 devrait se retrouver dans B10, F3 dans C10, I3 dans D10, A12 dans E10, A15 dans F10 et J18 dans G10. Si on suit cette idée la feuille nommé 002 se retrouvera sur la ligne 11 ainsi de suite.

 

[job75]

Bonsoir My<3,

Rien ne vous empêche de boucler sur toutes les feuilles de calcul :

Sub transfert_donnée()
Dim tableau, Derlig&, n%
With ActiveSheet
    tableau = Array(.[C3], .[F3], .[I3], .[A12], .[A15], .[J18])
End With
For n = 1 To Worksheets.Count
    With Worksheets(n)
        If .Name <> ActiveSheet.Name Then
            Derlig = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            .Cells(Derlig, "B").Resize(, UBound(tableau) + 1) = tableau
        End If
    End With
Next
End Sub

A+

 

[My<3]

Bonsoir My<3,

Rien ne vous empêche de boucler sur toutes les feuilles de calcul :

Sub transfert_donnée()
Dim tableau, Derlig&, n%
With ActiveSheet
    tableau = Array(.[C3], .[F3], .[I3], .[A12], .[A15], .[J18])
End With
For n = 1 To Worksheets.Count
    With Worksheets(n)
        If .Name <> ActiveSheet.Name Then
            Derlig = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
            .Cells(Derlig, "B").Resize(, UBound(tableau) + 1) = tableau
        End If
    End With
Next
End Sub

A+

Quand vous dit boucler c'est l'ajouter a toutes les feuilles? C'est que parfais des révisions doivent être apporter et a ce moment les informations descende d'une ligne

 

[job75]

Boucler c'est créer une boucle For/Next comme j'ai fait...