Add column headers to newly created worksheet and add formatting to all columns

1. add two new column headers in column C (mileage on time card) & D (overage)

wsO.Range("C1:D1").Value = [{"mileage on time card","overage"}]

2. automatically adjust the column width to fit the content

wsO.Columns.Autofit

3. add the following function to column D =SUM(B2-C2) and only show the value if it's a negative number

Dim LR as Long

LR = wsO.Range("A" & Rows.Count).End(xlUp).Row
wsO.Range("C2:C" & LR).Formula = "=IF(B2-C2<0, B2-C2, """")"

So maybe that code should be putting that formula in column D instead of column C.

JBeaucaire,

Yes, of course. Changed code to reflect the desired column and it worked like a charm. The following is the code as it stands currently.

Option Explicit

Sub Sample()
    Dim wbI As Workbook, wbO As Workbook
    Dim wsI As Worksheet, wsO As Worksheet

    '~~> Source/Input Workbook
    Set wbI = ThisWorkbook
    '~~> Set the relevant sheet from where you want to copy
    Set wsI = wbI.Sheets("Mileage Approvals")

    '~~> Destination/Output Workbook
    Set wbO = Workbooks.Add

    With wbO
        '~~> Set the relevant sheet to where you want to paste
        Set wsO = wbO.Sheets("Sheet1")

        '~~> Copy the range
        wsI.Range("A1:G400").Copy
        

        '~~> Paste it in say Cell A1. Change as applicable
               
        wsO.Range("A1:G300").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
        wsO.Range("D1:G1").Value = [{"Mileage on Time Card","Overage", "Employee", "Week Ending"}]
           
        '~~> Bold top row
           
        Rows("1:1").Select
        Selection.Font.Bold = True
        
        '~~> Fit content to column and center text in columns B, C, D
        
        wsO.Columns("B:B").HorizontalAlignment = xlCenter
            wsO.Columns("C:C").HorizontalAlignment = xlCenter
                wsO.Columns("D:D").HorizontalAlignment = xlCenter
                    wsO.Columns("E:E").HorizontalAlignment = xlCenter
                        wsO.Columns("F:F").HorizontalAlignment = xlCenter
        
        '~~> Sets different column widths for columns A, B, C, D
        
         Columns("A").AutoFit
            Columns("B").ColumnWidth = 10
                Columns("C").ColumnWidth = 10
                    Columns("D").ColumnWidth = 10
                        Columns("E").ColumnWidth = 10
                            Columns("F").ColumnWidth = 25
        
        Dim LR As Long


        LR = wsO.Range("A" & Rows.Count).End(xlUp).Row
        wsO.Range("D2:E400" & LR).NumberFormat = "0"
        
        LR = wsO.Range("A" & Rows.Count).End(xlUp).Row
        wsO.Range("E2:E" & LR).Formula = "=IF(C2-D2<0, C2-D2,"""")"
              
        LR = wsO.Range("A" & Rows.Count).End(xlUp).Row
        wsO.Range("G2:G400" & LR).NumberFormat = "mm/dd/yy"
              
        LR = wsO.Range("A" & Rows.Count).End(xlUp).Row
        wsO.Range("G2:G" & LR).Formula = "=TODAY()-WEEKDAY(TODAY(),3)+IF(WEEKDAY(TODAY(),3)>4,11,4"
            
        
        
        
               
    End With
End Sub

I'm still coming up short on how to adjust my code to adjust what is copied and pasted from the original workbook to the newly created workbook. This is what I'm trying to accomplish:

From the Original Workbook to the New Workbook

Column A-Copy and Paste ALL
Column B-Copy and Paste ALL
Column C-Copy and Paste ALL
Column D-Copy borders & cell background color only and Paste borders & cell background color only
Column E-Copy borders & cell background color only and Paste borders & cell background color only
Column F-Copy borders & cell background color only and Paste borders & cell background color only
Column G-Copy borders & cell background color only and Paste borders & cell background color only

Thanks again for any feedback you may be able/willing to offer.

Here's my Dummy workbook with the above code at work. Thanks.

Mileage Approval Spreadsheet DUMMY.xlsm


Matthew

This is how I would do that with your code:

Option Explicit

Sub Sample()
Dim wbI As Workbook, wbO As Workbook
Dim wsI As Worksheet, wsO As Worksheet
Dim LR As Long

Set wbI = ThisWorkbook                          'Source/Input Workbook
Set wsI = wbI.Sheets("Mileage Approvals")       'Set the relevant sheet from where you want to copy
Set wbO = Workbooks.Add                         'Destination/Output Workbook
Set wsO = wbO.Sheets("Sheet1")                  'Set the relevant sheet to where you want to paste

With wsO
    wsI.Range("A1").CurrentRegion.Copy .Range("A1")      'Paste it in say Cell A1. Change as applicable
    .Range("D:G").ClearContents
    
    .Range("D1:G1").Value = [{"Mileage on Time Card","Overage", "Employee", "Week Ending"}]
    .Rows("1:1").Font.Bold = True                   'Bold top row
    .Range("B:G").HorizontalAlignment = xlCenter    'formatting
    .Columns("A").AutoFit
    .Columns("B:E").ColumnWidth = 10
    .Columns("F").ColumnWidth = 25
    .Columns("G").ColumnWidth = 15
    
    LR = .Range("A" & .Rows.Count).End(xlUp).Row
    .Range("D2:E" & LR).NumberFormat = "0"
    .Range("E2:E" & LR).Formula = "=IF(C2-D2<0, C2-D2,"""")"
    .Range("G2:G" & LR).NumberFormat = "mm/dd/yy"
    .Range("G2:G" & LR).Formula = "=TODAY()-WEEKDAY(TODAY(),3)+IF(WEEKDAY(TODAY(),3)>4,11,4)"
End With

End Sub

If that takes care of your original question, please select Thread Tools from the menu link above and mark this thread as SOLVED. Thanks.

Typing in the columns after the macro has run does not retrigger the autofit, it only autofits based on the content of the columns at the time the macro runs.