Bonjour Dormokos,
voici ton fichier! Un petit bouton rouge à cliquer qui disparaîtra, son office accompli!
Private Sub cmdGO_Click()
'
Dim tTabA, tTab()
'
iRow = Range("A" & Rows.Count).End(xlUp).Row
tTabA = Range("A1:A" & iRow)
Range("A:A").ClearContents
iLig2 = 2
'
For x = 1 To iRow Step 20
ReDim tTab(5, 5)
iLig1 = 0: iCol1 = 0
For y = x To x + 19
tTab(iLig1, iCol1) = tTabA(y, 1)
iLig1 = iLig1 + 1
If y Mod 5 = 0 Then
iCol1 = iCol1 + 1: iLig1 = 0
End If
If y Mod 20 = 0 Then
iIdx = iIdx + 1: iCol2 = -4 + (5 * iIdx)
sCol = Split(Columns(iCol2).Address(ColumnAbsolute:=False), ":")(1)
Range(sCol & iLig2).Resize(5, 4) = tTab
Range(sCol & iLig2 - 1).Resize(6, 4).BorderAround LineStyle:=xlContinuous
Range(sCol & iLig2 - 1).Resize(1, 4).BorderAround LineStyle:=xlContinuous
Range(sCol & iLig2 - 1).Resize(1, 4).Interior.Color = RGB(215, 215, 215)
End If
Next
If iIdx = 5 Then
iIdx = 0: iLig2 = IIf(iLig2 Mod 15 = 8, iLig2 + 9, iLig2 + 6)
End If
Next
iCol = Cells(3, Columns.Count).End(xlToLeft).Column
sCol = Split(Columns(iCol).Address(ColumnAbsolute:=False), ":")(1)
Columns("A:" & sCol).AutoFit
Me.cmdGO.Visible = False
'
End Sub
Avec plaisir!
A+