Option Explicit
Dim cell As Range
Dim equipement As String, theme As String, intitule As String
Dim i As Integer, j As Integer, Fin_tab As Integer
Sub test()
Application.ScreenUpdating = False
'****************************************************************************
'***************************** Tests logiques *******************************
'****************************************************************************
equipement = Range("C4")
theme = Range("C5")
intitule = Range("C6")
If Range("C4") = "" Then equipement = "(TOUS)"
If Range("C5") = "" Then theme = "(TOUS)"
If Range("C6") = "" Then intitule = "(TOUS)"
'****************************************************************************
' premettra de limiter les options des boucles If
'****************************************************************************
'****************************************************************************
'******************** Éffacement des dernières données **********************
'****************************************************************************
If Range("D12") <> "" Then
i = Range("D65536").End(xlUp).Row
j = Range("D12").End(xlToRight).Column
Range("D12:" & Cells(i, j).Address).ClearContents
Range("D12:" & Cells(i, j).Address).RowHeight = 13
Range("D12:" & Cells(i, j).Address).Interior.ColorIndex = xlNone
Range("D12:" & Cells(i, j).Address).Borders.LineStyle = xlNone
End If
'****************************************************************************
'****************************************************************************
Fin_tab = Sheets("National").Range("B3").End(xlDown).Row 'dernière ligne du tableau
For Each cell In Sheets("National").Range("B3:B" & Fin_tab + 1) 'contrôle effectué sur le theme
'**************************
'***** Tests cellules *****
'**************************
If equipement <> "(TOUS)" And theme <> "(TOUS)" And intitule = "(TOUS)" Then ' obligation de choisir C4 et C5
If cell.Offset(0, -1) Like "*" & equipement & "*" Then 'on contrôle d'abord la cellule d'équipement du tableau
'**************************
'***** Fin des tests ******
'**************************
i = Range("D65536").End(xlUp).Row + 1
If cell Like "*" & theme & "*" Then 'on contrôle la cellule theme du tableau
Cells(i, 4) = cell.Value
Cells(i, 4).Interior.Color = cell.Interior.Color
Cells(i, 4).RowHeight = cell.RowHeight 'facultatif
Cells(i, 5) = cell.Offset(0, 1).Value
Cells(i, 5).Interior.Color = cell.Offset(0, 1).Interior.Color
Cells(i, 5).RowHeight = cell.Offset(0, 1).RowHeight 'facultatif
Cells(i, 6) = cell.Offset(0, 4).Value
Cells(i, 6).Interior.Color = cell.Offset(0, 4).Interior.Color
Cells(i, 6).RowHeight = cell.Offset(0, 4).RowHeight 'facultatif
Cells(i, 7) = cell.Offset(0, 8).Value
Cells(i, 7).Interior.Color = cell.Offset(0, 8).Interior.Color
Cells(i, 7).RowHeight = cell.Offset(0, 8).RowHeight 'facultatif
End If
End If
End If
Next cell
'****************************************************************************
'************************ Bordures sur les données **************************
'****************************************************************************
i = Range("D65536").End(xlUp).Row
j = Range("D11").End(xlToRight).Column
Range("D11:" & Cells(i, j).Address).Borders.Weight = xlThin
'****************************************************************************
'****************************************************************************
Application.ScreenUpdating = True
End Sub