bonjour à tous
j'utilise cette macro depuis de nombreux mois sans aucun problème et tous fonctionne parfaitement.
mais je voudrais ajouter à l'importation de la ligne Pro une couleur de fond en meme temps que le nom on va dire bleu. comment ajouter cette petite option svp merci
si un fichier joint est obligatoire j’essaierais de le mettre car l'ensemble est déja trés lourd avec des donnés sensible merci à vous
j'utilise cette macro depuis de nombreux mois sans aucun problème et tous fonctionne parfaitement.
mais je voudrais ajouter à l'importation de la ligne Pro une couleur de fond en meme temps que le nom on va dire bleu. comment ajouter cette petite option svp merci
Code:
Sub Maj_Dispo()
Dim TE(), LE As Long, CE As Long, TS(), LS As Long, CS As Long, TLC() As Long, FSource As Worksheet, FeuilTemp As String
FeuilSelect = Sheets("Dispo").Range("A6").Text
'MsgBox FeuilSelect
On Error Resume Next
FeuilTemp = Sheets(FeuilSelect).Range("P2")
' MsgBox FeuilTemp
Set FSource = ThisWorkbook.Sheets(FeuilTemp)
TE = Intersect(Application.Range(FSource.Rows(2), FSource.Rows(FSource.Rows.Count)), FSource.UsedRange).Value
ReDim TS(1 To UBound(TE, 1) \ 3 + 1, 1 To UBound(TE, 2) * 3 - 2)
ReDim TLC(1 To UBound(TS, 2))
For LE = 2 To UBound(TE, 1)
For CE = 2 To UBound(TE, 2)
On Error Resume Next
Select Case TE(LE, CE)
Case "M": CS = CE * 3 - 5
Case "A": CS = CE * 3 - 4
Case "N": CS = CE * 3 - 3
Case "Pro": CS = CE * 3 + (LE - 2) Mod 3 - 5
Case Else: CS = 0: End Select
If CS > 0 Then
LS = TLC(CS) + 1: TLC(CS) = LS
TS(LS, CS) = TE(LE - (LE - 2) Mod 3, 35)
End If: Next CE, LE
Sheets("Dispo").[B3].Resize(UBound(TS, 1), UBound(TS, 2)).Value = TS
'Trie.Triealpha
End Sub
si un fichier joint est obligatoire j’essaierais de le mettre car l'ensemble est déja trés lourd avec des donnés sensible merci à vous