Bonsoir BenPnL27, le forum,
A tester....
Sub test()
Dim i%, k%, j%
Dim tablo, tabloR(), titres
With Sheets("BDD")
tablo = .Range("A2").CurrentRegion
titres = Array("Code article", "Jour", "Heure début", "Heure fin", "Tranche horaire")
k = 0
For i = 2 To UBound(tablo, 1)
For j = 5 To 29
ReDim Preserve tabloR(1 To 5, 1 To k + 1)
If UCase(tablo(i, j)) = UCase("x") Then
tabloR(1, k + 1) = tablo(i, 1)
tabloR(2, k + 1) = tablo(i, 2)
tabloR(3, k + 1) = tablo(i, 3)
tabloR(4, k + 1) = tablo(i, 4)
tabloR(5, k + 1) = tablo(1, j)
k = k + 1
End If
Next j
Next i
On Error Resume Next
With Sheets("test")
.Cells.ClearContents
.Range("A1").Resize(1, 5) = titres: .Range("A1").Resize(1, 5).Font.Bold = True
.Range("A2").Resize(UBound(tabloR, 2), 5) = Application.Transpose(tabloR)
.Columns.AutoFit
.Select
End With
Erase tabloR: Erase tablo: Erase titres
End With
End Sub
- Code à placer dans un module standard
- Macro à associer à un bouton
Cordialement,