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

My<3

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

Membres actuellement en ligne

Statistiques des forums

Discussions
303 601
Messages
2 012 547
Membres
219 333
dernier inscrit
ludo719