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 |
Partager