Sub Coller_Tableau()
Dim P As Range, nlig&, zone As Range, ean&, cel As Range, col As Range, nref, n&, i&, j&, ajout&
With Sheets("Fusion BH")
Set P = .[A1].CurrentRegion.Resize(, 4)
nlig = P.Rows.Count
Set zone = .[U5:V5]
End With
With Sheets("TABLEAU")
ean = Application.CountIf(.Range("A11:A" & .Rows.Count), "><")
If ean = 0 Then MsgBox "Aucun EAN en feuille TABLEAU !", 48: Exit Sub
Application.ScreenUpdating = False
For Each cel In zone
Set col = IIf(cel.Address = zone(1).Address, .Columns("J"), .Columns("P")) 'colonne de destination
nref = Int(Val(CStr(cel)))
cel = nref
If nref > ean Then
MsgBox "Le nombre en " & cel.Address(0, 0) & " ne peut être supérieur à " & ean & " !", 48
ElseIf nref > 0 Then
n = 0
For i = 11 To .Cells.SpecialCells(xlCellTypeLastCell).Row
If Trim(.Cells(i, 1)) <> "" Then
n = n + 1
If n = nref Then
For j = i + 1 To .Rows.Count
If .Cells(j, 1).Borders(xlEdgeTop).Weight = xlMedium Then Exit For 'repérage de la dernière ligne par la bordure
Next j
ajout = nlig + 2 - j + i
If ajout > 0 Then .Rows(j - 1).Resize(ajout).Insert: j = j + ajout
With col.Cells(i).Resize(j - i, 4)
.Clear 'RAZ
.Borders.Weight = xlThin
P.Copy .Cells(1)
.Borders(xlEdgeTop).Weight = xlMedium
.Borders(xlEdgeRight).Weight = xlMedium
.Borders(xlEdgeBottom).Weight = xlMedium
End With
Exit For
End If
End If
Next i
End If
Next cel
Application.Goto .[A1], True 'facultatif
End With
End Sub