VBA qui crée des tableaux en fonction d'une liste de données

Bonjour,

Contrairement à beaucoup qui s'offusquent quand un demandeur poste dans plusieurs forums, cela ne me dérange pas.
En revanche, je ne trouverais sympa que le même demandeur, quand il a eu une solution ailleurs, la propose ici pour deux raisons :
1. Pour faire bénéficier d'autres personnes qui auraient le même genre de problème.
2. Pour éviter de faire perdre du temps aux personnes qui pourraient lui venir en aide...

Voilà, Onyirimba/Dreampower75

Bonjour,
Ok c'est noté
j'ai eu une solution ci-après :

merci de votre aide Forum

Sub Macro1()
Dim OM As Worksheet 'déclare la variable OM (Onglet Modèle)
Dim OP As Worksheet 'déclare la variable OP (Onglet PFA 01 2022)
Dim OD As Worksheet 'déclare la variable OD (Onglet Détail des heures)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim PL As Range 'déclare la variable PL (PLage)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OM = Worksheets("Modèle") 'définit l'onglet OM
Set PL = OM.Range("A8:K19") 'définit la plage PL
Set OP = Worksheets("PFA 01 2022") 'définit l'onglet OP
DL = OP.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OP
Set OD = Worksheets("Détail des heures") 'définit l'onglet OD
OD.Rows(8 & ":" & Application.Rows.Count).Delete 'efface les anciennes données de l'onglet OD
TV = OP.Range(OP.Cells(17, "A"), OP.Cells(DL, "A")) 'définit le tableau des valeurs TV
Set DEST = OD.Range("A8") 'initialise la cellule de destination DEST
For I = 1 To UBound(TV, 1) 'boucle sur toutes les ligne I du tableau des valeurs
PL.Copy DEST 'copie la plage PL dans la cellule de destination DEST
DEST.Resize(11, 1).Value = TV(I, 1) 'copie la donnée ligne I colonne 1 de TV dans la cellue de destination DEST redimensionnée

Set DEST = DEST.Offset(13, 0) 'redéfinit la cellule de destination DEST

If TV(I, 1) = "" Then
Exit For
End If

Next I 'prochaine ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
OD.Activate 'active l'onglet OD
MsgBox "Boards are completed !" 'message
End Sub