Remplir un tableau d'apres un autre tableau

Bonjour,

Essayez ceci:
Pièce jointe 594481

le code
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub Remplissage_Tableaux()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long, DerCol_f2 As Long
    Dim i As Long, j As Long
 
    Application.ScreenUpdating = False
    Set f1 = Sheets("First")
    Set f2 = Sheets("OUTPUT")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("A" & Rows.Count).End(xlUp).Row
    DerCol_f2 = f2.Range("XFD4").End(xlToLeft).Column
 
    For i = 4 To DerLig_f2 Step 28
        For j = 1 To DerCol_f2 Step 13
            f2.Cells(i + 1, j + 1).FormulaArray = "=IFERROR(INDEX(First!R1C1:R" & DerLig_f1 & "C15,MATCH(1,(First!R1C1:R" & DerLig_f1 & "C1=R" & i - 3 & "C" & j + 1 & ")*(First!R1C4:R" & DerLig_f1 & "C4=R" & i - 2 & "C" & j + 1 & ")*(First!R1C2:R" & DerLig_f1 & "C2=RC" & j & "),0),MATCH(R4C,First!R1C1:R1C15,0)),"""")"
            f2.Cells(i + 1, j + 1).AutoFill Destination:=Range(f2.Cells(i + 1, j + 1), f2.Cells(i + 1, j + 11)), Type:=xlFillDefault
            Range(f2.Cells(i + 1, j + 1), f2.Cells(i + 1, j + 11)).AutoFill Destination:=Range(f2.Cells(i + 1, j + 1), f2.Cells(i + 23, j + 11)), Type:=xlFillDefault
            Range(f2.Cells(i + 1, j + 1), f2.Cells(i + 23, j + 11)).Value = Range(f2.Cells(i + 1, j + 1), f2.Cells(i + 23, j + 11)).Value
        Next j
    Next i
    f2.Select
    Set f1 = Nothing
    Set f2 = Nothing
End Sub
Cdlt