Macro help for Copying formats

[Wolfee200]

I have been working on this for a while and I found I am doing some things to the created spreadsheet that I would like to add to my Macro but unsure on how.

I would like to copy the formating from Spreadsheet one to the new spreadsheet instead of having the macro format the cells in the new spreadsheet.

This is my full code.

Private Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
Dim r As Long, c As Integer
Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer
Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
Dim rptWB As Workbook, DiffCount As Long
    Application.StatusBar = "Creating the report..."
 
    Set rptWB = Workbooks.Add
 
    Application.DisplayAlerts = False
    While Worksheets.Count > 1
        Worksheets(2).Delete
    Wend
    Application.DisplayAlerts = True
    With ws1.UsedRange
        lr1 = .Rows.Count
        lc1 = .Columns.Count
    End With
    With ws2.UsedRange
        lr2 = .Rows.Count
        lc2 = .Columns.Count
    End With
    maxR = lr1
    maxC = lc1
    If maxR < lr2 Then maxR = lr2
    If maxC < lc2 Then maxC = lc2
    DiffCount = 0
 
    'add Copy the Header Rows from one of the two spread sheets
 
    frmImpPFADates.LabelProgress.Width = 0
    For c = 1 To maxC  'Columns
 
     'Updating the Progress bar in the form
        If c = 1 Then
            PctDone = Int(c) / Int(maxC - 1)
        Else
            PctDone = Int(c - 1) / Int(maxC - 1)
        End If
        With frmImpPFADates
            .ProgressLabel.Caption = "Comparing Worksheets: " & c - 1 & " of " & maxC & "Columns Complete"
            .FrameProgress.Caption = Format(PctDone, "0%")
            .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        End With
 
        Application.StatusBar = "Comparing cells " & Format(c / maxC, "0 %") & "..."
      'End of Progress Bar
 
        For r = 1 To maxR  'Rows
            cf1 = ""
            cf2 = ""
            On Error Resume Next
            cf1 = ws1.Cells(r, c).FormulaLocal
            cf2 = ws2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                ' ws1.Cells(r, c).Font.Color = -11480942
 
                DiffCount = DiffCount + 1
                Cells(r, c).Formula = cf1
                'Cells(r, c).
                ' Cells(r, c).Formula = "'" & cf1 & " <> " & cf2
                Cells(r, 1).Formula = "Change"
                Cells(1, c).Formula = "Change"
            End If
        Next r
    Next c
    Application.StatusBar = "Formatting the report..."
    With Range(Cells(1, 1), Cells(maxR, maxC))
        .Interior.ColorIndex = 19
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error Resume Next
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error GoTo 0
    End With
    Columns("A:IV").ColumnWidth = 20
    Application.StatusBar = False
    Application.ScreenUpdating = True
    MsgBox DiffCount & " cells contain different formulas!", vbInformation, _
        "Compare " & ws1.Name & " with " & ws2.Name
End Sub

This is the code I would like to change to copying the formats from ws1 to the new sheet.

With Range(Cells(1, 1), Cells(maxR, maxC))
        .Interior.ColorIndex = 19
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error Resume Next
        With .Borders(xlInsideHorizontal)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        With .Borders(xlInsideVertical)
            .LineStyle = xlContinuous
            .Weight = xlHairline
        End With
        On Error GoTo 0
    End With

Thanks,

Em'Ee Wolfe

 

[cjcobra]

when you copy, you need to paste-special-formats.

Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

 

[Wolfee200]

I have tried but get different errors when trying as I can't figure out in Code how to change workbooks. I am copying from ws1 in the code and I don't know how to change to rptWB in the Past Special command.

 

[Wolfee200]

One of the errors I receive is Expected Function or Variable.