Copy to new Workbook without Gridlines

JADownie

Active Member
Joined
Dec 11, 2007
Messages
395
Hello -

I have this macro below which works PERFECT, except for one thing now. I am trying clean up the presentation and was hoping there was an easy way to add in a statement whereby all cells in the new workbook were white background - i.e. no gridlines showing outside of any tables present. Is that something easy I can add into my existing code here now?

Thanks in advance for any guidance and assistances here. :)



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
End With

'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

'Increase font size of copied header row range using the CurrentRegion
wsNewSummary.Cells(lngInsertRow, 1).CurrentRegion.Font.Size = 14

'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

'Activate the New Summary worksheet
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 Sub
 

Excel Facts

Back into an answer in Excel
Use Data, What-If Analysis, Goal Seek to find the correct input cell value to reach a desired result
Can I just add a line here to easily change cells all to white?

'Create a new workbook
Set wbNew = Workbooks.Add

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

Forum statistics

Threads
1,214,647
Messages
6,120,722
Members
448,987
Latest member
marion_davis

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top