Bonjour,
Sub RépartirDonnées()
Dim aa, tbo, tft(), n%, i%, f%, ln%
ReDim tft(2 To Worksheets.Count)
For i = 2 To Worksheets.Count
With Worksheets(i)
n = InStr(1, .Name, " - ") - 1
tft(i) = Left(.Name, n)
End With
Next i
With ActiveSheet
n = .Cells(.Rows.Count, 10).End(xlUp).Row
tbo = .Range("J3:J" & n).Value
aa = .Range("B3:I" & n).Value
For i = 1 To UBound(tbo)
For n = 2 To UBound(tft)
If tbo(i, 1) = tft(n) Then tbo(i, 1) = n: Exit For
Next n
Next i
End With
Erase tft: n = 0
For f = 2 To Worksheets.Count
For i = 1 To UBound(tbo)
If tbo(i, 1) = f Then
ReDim Preserve tft(n)
tft(n) = WorksheetFunction.Index(aa, i, 0)
n = n + 1
End If
Next i
With Worksheets(f)
ln = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If ln < 3 Then ln = 3
.Cells(ln, 1).Resize(n, 8).Value = WorksheetFunction.Transpose( _
WorksheetFunction.Transpose(tft))
End With
Erase tft: n = 0
Next f
MsgBox "Répartition réalisée.", vbInformation, "Confirmation"
End Sub
C'était en principe une réponse plutôt rapide à faire ! Mais c'était sans compter avec quelques particularités qu'il a fallu contourner !
- une colonne parasite intercalée dans les lignes à transférer ! celle-là je l'ai déplacée en A car elle ne m'aurait pas permis de coder comme j'entendais le faire... (mais les autres particularités il a fallu les contourner dans le code qui aurait été plus simple sans cela)
- des noms de feuilles non correspondants à ceux indiqués dans la dernière colonne
- un nom (Rappel t) doté en outre d'une espace en trop avant tiret (que j'ai supprimée, mais il a fallu chercher l'erreur)
- une colonne sans libellé d'en-tête.
Prends-en note pour tes prochaines réalisations...
La macro est conçue pour ajouter les lignes à des données déjà existantes dans la feuille. Tu n'avais pas précisé ce point, j'ai donc opté pour un ajout de données (si ce n'était pas le cas, il faudrait introduire l'effacement des feuilles cibles avant d'insérer les données). L'option ajout supposerait un fonctionnement consistant à transférer les lignes de la première feuille sur leur feuille destinataire, puis à effacer cette première feuille, un nouveau lot saisi ensuite pouvant faire l'objet d'un nouvel ajout, etc.. Je n'ai cependant pas pris la liberté d'introduire l'effacement en fin, tu pourras facilement le faire...
J'ai ajouté un message de confirmation de l'opération à la fin pour que tu ne soies pas déstabilisé de ne rien voir bouger !
On travaille avec des tableaux : on extrait en tableau la plage de lignes à transférer (col. B à I), par ailleurs la plage-colonne indiquant les destinations (J). On extrait dans un tableau temporaire les noms de feuilles (en réduisant leur libellé à la partie figurant en destination).
Une première phase consiste à remplacer les noms de feuilles dans le tableau destination par leur index, en utilisant le tableau noms où elle figure dans l'ordre.
La phase principale consiste à faire une boucle sur les feuilles cibles, en répétant pour chacune : parcours du tableau destination, si correspondance index de feuille, on prélève la ligne qu'on affecte à un tableau résultat (incrémenté au fur et à mesure), puis on affecte ce tableau à la plage destination après l'avoir délimitée.
Cordialement.