Apply Font, Font Size, and Font Color

[Legacy 436357]

Hello,

Is there a way to alter this code to post the font, font size, and font color to the destination sheets?
What I mean is to maintain the individual cells from the source sheets.
Thank you very much for your help,
XJ

<code>Sub AddEventsToSheets()
   Call ClearCells
   Dim ws As Worksheet, sh As Worksheet
   Dim Rng As Range, c As Range, fNd As Range
   Dim NrNg As Range, g As Range, m As String
   For Each ws In Sheets(Array("Holidays", "Events"))
      With ws
         Set Rng = .Range("A3:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
         For Each c In Rng.Cells
            m = Format(c, "MMMM")
            Set NrNg = Sheets(m).Range("A3:N33").SpecialCells(xlCellTypeFormulas, 23)
            For Each g In NrNg
               If g.Value = c.Value Then
                  g.Resize(6).SpecialCells(xlBlanks)(1).Value = c.Offset(, 1)
               End If
            Next g
         Next c
         Set Rng = .Range("H3:H" & .Cells(.Rows.Count, "H").End(xlUp).Row)
         For Each c In Rng.Cells
            If Month(c) = 1 Then
               m = "december"
               Set NrNg = Sheets(m).Range("A3:N33").SpecialCells(xlCellTypeFormulas, 23)
               For Each g In NrNg
                  If g.Value = c.Value Then
                     g.Resize(6).SpecialCells(xlBlanks)(1).Value = c.Offset(, 1)
                  End If
               Next g
            End If
         Next c
      End With
   Next ws
End Sub

</code>

 

[Yongle]

Try something like this
Declare another variable

Dim d as Range

replace (twice):

g.Resize(6).SpecialCells(xlBlanks)(1).Value = c.Offset(, 1)

with:

set d = c.Offset(, 1)
With g.Resize(6).SpecialCells(xlBlanks)(1)
   .Value = d
   .Font.Name = d.Font.Name
   .Font.Size = d.Font.Size
   .Font.ColorIndex = d.Font.ColorIndex
End With

Code

 

[Legacy 436357]

Thank you very much that works perfectly.

 

[Yongle]

thanks for feedback