Duplicate contents including formatting

[Lstallan]

Help needed with duplicating formatting (not conditional)

At the moment a daily worksheet is completed which has some basic font colour formatting in it, but there is no conditional formatting I can use. It is manually formatted.

I want to duplicate the daily sheets to a different layout on a weekly sheet. I'm doing this using:
=IF(Wednesday!A7="0600-1800","DTL",Wednesday!A7)

This doesn't copy the formatting which is manually added on the "Wednesday" sheet, to the weekly sheet which contains the =IF argument remains without formatting.

Any ideas???

 

[Fluff]

Ok, does this work for the Wednesday sheet?

Sub CopyData()
   Dim Ws As Worksheet
   Dim Mws As Worksheet
   Dim Ar1 As Areas
   Dim Ar2 As Areas
   Dim i As Long, j As Long
   
   Set Mws = Sheets("Week")
   
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Wednesday"
            Set Ar2 = Mws.Range("D3:D6, D7:D12, F3:F13, H3:H6, H7:H12, J3:J13").Areas
         Case "Thursday"
            Set Ar2 = Mws.Range("D15:D18, D19:D24, F15:F25, H15:H18, H19:H24, J15:J25").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Value = Ar1(i).Value
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws
End Sub

 

[Lstallan]

tweaked it a little so that it handled each day separately, but it works a treat
Thanks

 

[Lstallan]

Spoke too soon :/
For some reason it's removing the formula that are in the cells and replacing them with the value. I need to retain the formulas so that any edits will be updated.
I've changed the "value" in the code to "formula" but it's made no difference.

The code now looks like this:

Sub CopyFormat()
   Dim Ws As Worksheet
   Dim Mws As Worksheet
   Dim Ar1 As Areas
   Dim Ar2 As Areas
   Dim i As Long, j As Long
   
   Set Mws = Sheets("Week")
   
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Wednesday"
            Set Ar2 = Mws.Range("D3:D6, D7:D12, F3:F13, H3:H6, H7:H12, J3:J13").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws

'Copy Thursday
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Thursday"
            Set Ar2 = Mws.Range("D15:D18, D19:D25, F15:F25, H15:H18, H19:H25, J15:J25").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws

'copy friday
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Friday"
            Set Ar2 = Mws.Range("D27:D30, D31:D37, F27:F37, H27:H30, H31:H37, J27:J37").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws

'copy saturday
    For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Saturday"
            Set Ar2 = Mws.Range("D39:D42, D43:D49, F39:F49, H39:H42, H43:H49, J39:J49").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws

'copy sunday
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Sunday"
            Set Ar2 = Mws.Range("D51:D54, D55:D61, F51:F61, H51:H54, H55:H61, J51:J61").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws

'copy monday
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Monday"
            Set Ar2 = Mws.Range("D63:D66, D67:D73, F63:F73, H63:H66, H67:H73, J63:J73").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws

'copy Tuesday
   For Each Ws In Worksheets
      Set Ar1 = Ws.Range("B7:B10, B12:B17, B29:B39, D7:D10, D12:D17, D29:D39").Areas
      Select Case Ws.Name
         Case "Tuesday"
            Set Ar2 = Mws.Range("D75:D78, D79:D85, F75:F85, H75:H78, H79:H85, J75:J85").Areas
      End Select
      If Not Ar2 Is Nothing Then
         For i = 1 To Ar2.Count
            Ar2(i).Formula = Ar1(i).Formula
            For j = 1 To Ar2(i).Count
               Ar2(i)(j).Font.Color = Ar1(i)(j).Font.Color
               Ar2(i)(j).Font.Bold = Ar1(i)(j).Font.Bold
            Next j
         Next i
      End If
      Set Ar1 = Nothing
      Set Ar2 = Nothing
   Next Ws
End Sub

 

[Fluff]

Try changing it to

 Ar1(i).Copy Ar2(i)

 

[Lstallan]

Nope.

The contents of the cells are still being replaced. I need to keep the formula, and only duplicate the formatting :/

 

[Fluff]

Try removing this line completely

Ar2(i).Formula = Ar1(i).Formula

 

[Lstallan]

Thanks to everyone who tried to offer support with regards this. In the end I did it the old fashioned (and somewhat time consuming) way, I recorded the macro where I just copied all the formatting manually and created a script that way. If it copies the cell background too, then so be it. I will just have to get the person who produces the daily sheets to change their formatting slightly.