Export Data to New Workbook

[JADownie]

I have this macro that works GREAT now, but I need to make an minor adjustment and need some help...

The part of code below in red is pasting a table of data into my new workbook, and all I want to do is increase the size of the font in the table header row to be 14 instead of 11. Is that just a matter of adding one or two lines of code into what I already have here below?


Thanks!!

Sub Export()

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim wsSummary As Worksheet, wbNew As Workbook, wsNewSummary As Worksheet
Dim loDD_Data As ListObject
Dim i As Integer, lngInsertRow As Long

'Source Summary Worksheet
Set wsSummary = ThisWorkbook.Worksheets("Summary")
'Source DD_Data table
Set loDD_Data = ThisWorkbook.Worksheets("AllData").ListObjects("DD_Data")

'Create a new workbook
Set wbNew = Workbooks.Add

'New Summary Worksheet
wbNew.Worksheets(1).Name = wsSummary.Name
Set wsNewSummary = wbNew.Worksheets(1)

'Delete any extra worksheets in the new workbook, if present
If wbNew.Worksheets.Count > 1 Then
For i = wbNew.Worksheets.Count To 2 Step -1
wbNew.Worksheets(i).Delete
Next
End If

'Copy the Job Summary Range
wsSummary.Range("rngJobSummary").Copy

'Paste to the new Summary worksheet
With wsNewSummary.Cells(1, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats

'Delete the data validation dropdown from cell B1 on the new summary worksheet
wsNewSummary.Cells(1, 2).Validation.Delete

'Find the last row on the worksheet and add 3 rows, this will be the insert row for the PivotTable values
lngInsertRow = wsNewSummary.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 3

'Copy the PivotTable TableRange1
wsSummary.PivotTables(1).TableRange1.Copy

'Paste the formats and values to the new Summary worksheet
With wsNewSummary.Cells(lngInsertRow, 1)
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteValues
End With

'Remove the wrap text from the copied PivotTable range
Selection.WrapText = False

'Find the last row on the worksheet and add 3 rows, this will be the insert row for the AllData table values
lngInsertRow = wsNewSummary.UsedRange.Cells.SpecialCells(xlCellTypeLastCell).Row + 3

'Remove the filters from the AllData table
Call modTableFunctions.fnShowAllData(loDD_Data)

'Filter the AllData table
Call modTableFunctions.sbFilterListObject(loDD_Data, loDD_Data.ListColumns("Job Number").Index, wsNewSummary.Cells(1, 2).Value, False)

'Filtered table returns one or more rows
If loDD_Data.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Rows.Count > 0 Then
'Copy the header row range
loDD_Data.HeaderRowRange.Copy
'Paste the header row range to the new Summary worksheet
wsNewSummary.Cells(lngInsertRow, 1).PasteSpecial xlPasteValues

'Copy the visible data body range
loDD_Data.DataBodyRange.Cells.SpecialCells(xlCellTypeVisible).Copy
'Paste the visible data body range to the new Summary worksheet
With wsNewSummary.Cells(lngInsertRow + 1, 1)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
End If

wsNewSummary.Activate

'Add Auto Filter
wsNewSummary.Range(Cells(lngInsertRow, 1), Selection.Cells.SpecialCells(xlCellTypeLastCell)).AutoFilter

'Remove the filters from the AllData table
Call modTableFunctions.fnShowAllData(loDD_Data)

'Activeate the Summary Worksheet in the macro workbook
wsSummary.Activate

'Autofit the column widths on the current worksheet
wsNewSummary.UsedRange.Columns.AutoFit

wsNewSummary.Activate
wsNewSummary.Cells(1, 2).Select

Application.DisplayAlerts = True

End With
End Sub

 

[JADownie]

I assume I just need to add a line here somewhere

'Copy the header row range
loDD_Data.HeaderRowRange.Copy
'Paste the header row range to the new Summary worksheet
wsNewSummary.Cells(lngInsertRow, 1).PasteSpecial xlPasteValues

 

[JoeMo]

Maybe:

Dim lO_Data As ListObject
With lO_Data.HeaderRowRange
    .Font.Size = 14
End With

You can copy it either before or after the font size change - not sure from your post which you want.