تعديل اللون في كود ترحيل ال الاصفر الاساسي

[ميلان]

السلام عليكم اصدقائي لدي كود قام بكتابته استاذنا الكبير سليم حاصيبا واعمل عليه وهو ممتاز الية الكود ترحيل البيانات من شيت لاخر وعند الضغط على زر طباعة يتغير لون صف العامود الذي اخترته الى لون 

ازرق كاشف والذي اصبح غير واضح لاني البس نظارات اريد تغيير اللون الى اصفر اساسي وشكرا للجميع الاخوة في هذا المنتدى الرائع الكود كالتالي في الشيت الاول والثاني :

Option Explicit
Dim S As Worksheet
Dim T As Worksheet
Dim last As Long, Ro%
Dim s_rg As Range
Dim i%, K%, My_ro1%, My_ro2%, My_ro%
Dim M As Byte, n As Byte, xx As Byte
'++++++++++++++++++++++++++++++++
Sub Fatura()
Application.ScreenUpdating = False
 Set S = Sheets("Source")
 Set T = Sheets("Target")
 xx = 1
last = S.Cells(Rows.Count, 1).End(3).Row
If Val(T.Range("J1")) <= 0 Then
  i = 1
 Else
  i = Int(Abs(T.Range("J1")))
 End If
  T.Range("J1") = i
 T.Range("Rg_ALL").ClearContents
  For K = i + 3 To i + 10
  If K > last Then Exit For
 Select Case xx Mod 8
  Case 1: M = 2: n = 2
  Case 2: M = 2: n = 5
  Case 3: M = 11: n = 2
  Case 4: M = 11: n = 5
  Case 5: M = 20: n = 2
  Case 6: M = 20: n = 5
  Case 7: M = 29: n = 2
  Case 0: M = 29: n = 5
  End Select
   S.Cells(K, 1).Resize(, 7).Copy
   T.Cells(M, n).PasteSpecial _
   12, Transpose:=True
   xx = xx + 1
Next
Application.CutCopyMode = False
Print_Area
T.Cells(2, 1).Select
Application.ScreenUpdating = True
End Sub
'+++++++++++++++++++++++++++++++++++
Sub Print_Area()
Set T = Sheets("Target")
Ro = T.Cells(Rows.Count, 1).End(3).Row
 For i = 2 To Ro - 6 Step 9
    If T.Cells(i, 2) <> "" Then
       My_ro1 = i + 6
    End If
 Next
  For i = 2 To Ro - 6 Step 9
      If T.Cells(i, 5) <> "" Then
       My_ro2 = i + 6
    End If
 Next
 My_ro = Application.Max(My_ro1, My_ro2)
   T.PageSetup.PrintArea = T.Range("A1:E" & My_ro).Address
End Sub
الشبيت الثاني 
Option Explicit
Dim S As Worksheet
Dim B As Worksheet
Dim last%, i%
Dim dic As Object
Dim Mon_array
Dim Itm
Dim Nb%
'++++++++++++++++++++++++++++++++
Sub Fatura_One()
Set S = Sheets("Source")
Set B = Sheets("By_one")
Set dic = CreateObject("Scripting.Dictionary")
last = S.Cells(Rows.Count, 1).End(3).Row
S.Range("A4").Resize(last, 9).Interior.ColorIndex = xlNone
For i = 4 To last
  If Not IsEmpty(S.Cells(i, 2)) Then
    S.Cells(i, 1).Resize(, 9).Interior.ColorIndex = 35
     Mon_array = Application.Transpose _
     (S.Cells(i, 1).Resize(, 9))
    Mon_array = Join(Application.Transpose(Mon_array), "*")
    dic(dic.Count) = Mon_array
  End If
Next
If dic.Count Then
 For Each Itm In dic.Items()
  B.Range("E6").Resize(9) = _
  Application.Transpose(Split(Itm, "*"))
 '==========================
  B.PrintPreview
 '========================
 Next
 End If
Set dic = Nothing
End Sub
'+++++++++++++++++++
Sub New_Month()
Set S = Sheets("Source")
last = S.Cells(Rows.Count, 1).End(3).Row
S.Range("A4:I" & last).Interior.ColorIndex = xlNone
S.Range("K4:K" & last) = vbNullString
End Sub

الشيت الاساسي 

جزاكم الله كل خير والملف في الاسفل 

OTOKAR 21.2.2021.xlsm

[سليم حاصبيا]

في هذا السطر من الكود استبدل الرقم 35 الى الرقم 6

S.Cells(i, 1).Resize(, 9).Interior.ColorIndex = 35

 

[ميلان]

استاذنا الكريم شكرا لمرورك الجميل واود ان اكرر شكري بأن الكود أعمل عليه وهوممتاز ولا يوجد اي خلل شكرا لك من القلب