Option Explicit
Sub MoveTab()
Dim Vide As Boolean
Dim Sht As Worksheet
Dim oList As ListObject
Dim Row As Integer
Dim R As Integer
Dim Target As String
Dim Tables
' On établit une liste des tables existantes dans le Document
Set Tables = CreateObject("Scripting.Dictionary")
For Each Sht In ThisWorkbook.Worksheets
For Each oList In Sht.ListObjects
Tables.Add oList.Name, vbNullString
Next
Next
[Valider].Parent.Activate
For Row = 1 To [Valider].Rows.Count
Select Case True
Case [Valider[Status]].Rows(Row) <> "To be Done"
Case Not Tables.Exists([Valider[Motif]].Rows(Row).Text)
Case Else
Target = [Valider[Motif]].Rows(Row)
Vide = Range(Target).ListObject.ListRows.Count = 0
Range(Target).ListObject.ListRows.Add
R = Range(Target).ListObject.ListRows.Count
[Valider].Rows(Row).Copy
Range(Target).Rows(R).PasteSpecial Paste:=xlPasteValues
[Valider].Rows(Row).Delete
If Vide Then
Range(Target).ListObject.DataBodyRange.Interior.Pattern = xlNone
Range(Target).ListObject.DataBodyRange.Font.ColorIndex = xlAutomatic
Range(Target).ListObject.DataBodyRange.Font.Bold = False
End If
End Select
Next
[Valider].Parent.Activate
[Valider[#Headers]].Activate
Application.CutCopyMode = False
Set Tables = Nothing
End Sub
Sub Convert_To_Tables()
With ActiveWorkbook.TableStyles.Add("MonStyle")
.ShowAsAvailablePivotTableStyle = False
.ShowAsAvailableTableStyle = True
.ShowAsAvailableSlicerStyle = False
.ShowAsAvailableTimelineStyle = False
End With
With Sheets("Demandes à valider")
.Cells.Font.Bold = False
.ListObjects.Add(xlSrcRange, .Range("$A$1:$H$8"), , xlYes, , "MonStyle").Name = "Valider"
.ListObjects("Valider").Range.AutoFilter
End With
Set_Table Sheets("Other")
Set_Table Sheets("Otherbis")
With Sheets("Macros")
.Shapes("Button 3").OnAction = "MoveTab"
.Activate
End With
End Sub
Sub Set_Table(Sh As Worksheet)
With Sh
With .Rows("2:" & .Rows.Count)
.Clear
.Delete
End With
.Cells.FormatConditions.Delete
.ListObjects.Add(xlSrcRange, .Range("$A$1:$H$2"), , xlYes, , "MonStyle").Name = .Name
With .ListObjects(.Name)
.Range.AutoFilter
With .DataBodyRange.Columns("B:G")
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:="=ET($A2-AUJOURDHUI()>14;$H2<>""Done"")")
.Interior.Color = vbGreen
End With
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:="=ET($A2-AUJOURDHUI()<=7;$H2<>""Done"")")
.Interior.Color = vbRed
End With
With .FormatConditions.Add(Type:=xlExpression, _
Formula1:="=ET($A2-AUJOURDHUI()>=8;$H2<>""Done"")")
.Interior.Color = vbYellow
End With
End With
.DataBodyRange.Delete
End With
End With
End Sub