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

My<3

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

VB:
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.
 
Dernière édition:

job75

XLDnaute Barbatruc
Bonsoir My<3,

Rien ne vous empêche de boucler sur toutes les feuilles de calcul :
VB:
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

XLDnaute Junior
Bonsoir My<3,

Rien ne vous empêche de boucler sur toutes les feuilles de calcul :
VB:
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
 

Discussions similaires

Réponses
3
Affichages
457
Réponses
7
Affichages
347

Statistiques des forums

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