1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
| Option Explicit
Sub bouton()
Dim th As Variant, tr As Variant
Dim i As Long, a As Integer, col As Integer
With ThisWorkbook.Sheets("Tableau habilitations")
th = .Range("A12:BL" & .Range("A" & Rows.Count).End(xlUp).Row)
End With
ReDim tr(1 To UBound(th, 1), 1 To UBound(th, 2))
With ThisWorkbook.Sheets("Tableau r?cap")
.Cells.ClearContents
.Range(.Cells(1, 1), .Cells(1, 3)) = Array("Nom", "Prenom", "Service")
'---
For i = 3 To UBound(th, 1)
col = 1
.Range(.Cells(i - 1, 1), .Cells(i - 1, 3)) = Array(th(i, 1), th(i, 2), th(i, 3))
For a = 6 To UBound(th, 2)
If UCase(th(2, a)) Like "*DATE*" And IsDate(th(i, a)) Then
tr(1, col) = "Habilitation": tr(1, col + 1) = "Date de Fin de Validit?"
tr(i - 1, col) = IIf(th(1, a - 1) = "", th(1, a - 2), th(1, a - 1)) ' donn?es sur 2 ou 3 colonnes
tr(i - 1, col + 1) = th(i, a)
col = col + 2
End If
Next a
Next i
'--
.Range(.Cells(1, 4), .Cells(i - 1, UBound(th, 2) + 4)) = tr
.Columns.AutoFit: .Columns.HorizontalAlignment = xlCenter
.Rows.WrapText = False
.Rows.AutoFit:: Rows.VerticalAlignment = xlCenter
End With
End Sub |
