Sub tesTransfert()
Dim TabTemp As Variant
Dim Tablo() As Variant
Dim derlgn As Integer, L As Integer, x As Integer
Dim C As Byte
Application.ScreenUpdating = False
With Worksheets('Feuil2')
TabTemp = .Range('A1:F' & .Range('A65536').End(xlUp).Row).Value
End With
With Worksheets('Feuil1')
For L = 1 To UBound(TabTemp, 1)
For C = 1 To UBound(TabTemp, 2)
.Cells(10, 10 + C) = TabTemp(L, C)
Next
Calculate
Select Case .Range('T10').Interior.ColorIndex 'ici je n'arrive pas a récuperer _
la couleur du Format conditionnel
Case Is = 2 'ici je teste le fond mais il est blanc lol _
donc il transfert tout
ReDim Preserve Tablo(UBound(TabTemp, 2), x) 'on dimensionne le tablo
'on charge normalement les lignes qui sont bonnes
For C = 0 To UBound(TabTemp, 2) - 1
Tablo(C, x) = TabTemp(L, C + 1)
Next
x = x + 1
Case Else
.Range('K10:P10').ClearContents 'si pas bon on efface sans copier dans le tablo
End Select
Next
End With
With Worksheets('Feuil3') 'ici on colle le tablo dans la feuille 3
.Range('A1').CurrentRegion.ClearContents 'on efface d'abord
.Range('A1').Resize(UBound(Tablo, 2) + 1, UBound(Tablo, 1)) = Application.Transpose(Tablo)
End With
Application.ScreenUpdating = True
End Sub