Copy content from 2 worksheets to 1 and remove formatting

[Iceshade]

Hi Everyone,

I could really use some help - been on this for a few days now. I am no expert at VBA but learning as I go and normally solve things on my own.

Is there a way to;

1. Create a new worksheet and name it "Print Summary"
2. Copy content from ActiveSheet to "Print Summary" (preserving column widths)
3. Copy content from worksheet "Checklist" and copy it to the next blank row in "Print Summary" (preserving column widths)
4. Remove all borders in "Print Summary"

I can't even begin to tell you all how grateful I'd be for some guidance here.

Thank you in advance !

 

[Trevor G]

From your thread when you create Print Summary this will only happen once.
When you copy data and column width it doesn't copy borders.
I don't know how many sheets you have in the workbook but you could give this a go and if not exactly what you want then post back

Sub tryMe()
Dim ws As Worksheet
    Application.ScreenUpdating = False
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Print Summary"
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Print Summary" Then
            ws.UsedRange.Copy
            With Sheets("Print Summary").Range("A1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteValues, , False, False
            End With
            
            Application.CutCopyMode = False
            Application.DisplayAlerts = False
            Application.DisplayAlerts = True
        End If
    Next
    Application.ScreenUpdating = True
End Sub

 

[JLGWhiz]

Unless ActiveSheet and Checklist have the same column widths, you will not be able to preserver both, the last one copied will dominate.

Sub t()
Dim sh As Worksheet, nsh As Worksheet
Set sh = ActiveSheet
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
nsh.Name = "Print Summary"
sh.UsedRange.Copy
nsh.Range("A1").PasteSpecial xlPasteValues
Sheets("Checklist").UsedRange.Copy
nsh.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
    For i = 1 To nsh.UsedRange.Columns.Count
        nsh.Columns(i).ColumnWidth = sh.Columns(i).ColumnWidth
    Next
Application.CutCopyMode = False
End Sub

 

[Iceshade]

From your thread when you create Print Summary this will only happen once.
When you copy data and column width it doesn't copy borders.
I don't know how many sheets you have in the workbook but you could give this a go and if not exactly what you want then post back

Sub tryMe()
Dim ws As Worksheet
    Application.ScreenUpdating = False
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Print Summary"
    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "Print Summary" Then
            ws.UsedRange.Copy
            With Sheets("Print Summary").Range("A1").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteValues, , False, False
            End With
           
            Application.CutCopyMode = False
            Application.DisplayAlerts = False
            Application.DisplayAlerts = True
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Thank you @Trevor G - I've tried this but it seems to be copying ActiveSheet and pasting all down column A, then half way down is printing the rest of ActiveSheet down column C. Additionally, its not grabbing any other worksheets, i.e. "Checklist".

 

[Iceshade]

Unless ActiveSheet and Checklist have the same column widths, you will not be able to preserver both, the last one copied will dominate.

Sub t()
Dim sh As Worksheet, nsh As Worksheet
Set sh = ActiveSheet
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
nsh.Name = "Print Summary"
sh.UsedRange.Copy
nsh.Range("A1").PasteSpecial xlPasteValues
Sheets("Checklist").UsedRange.Copy
nsh.Cells(Rows.Count, 1).End(xlUp)(2).PasteSpecial xlPasteValues
    For i = 1 To nsh.UsedRange.Columns.Count
        nsh.Columns(i).ColumnWidth = sh.Columns(i).ColumnWidth
    Next
Application.CutCopyMode = False
End Sub

Thank you @JLGWhiz - I can see what you're saying and I didn't think about the second 'paste' overriding the previous column widths. This code is kind of doing what I need it to, however it seems to be copying 'Checklist' at the top of 'Print Summary' as opposed to appending below the paste from 'Activesheet'.

Also, (and this is my fault for not being clear, I apologies) - when copying, can you get it to copy only visible rows? I have hidden rows which show based on another macro assigned to a dropdown. I want it to copy only what is visible in the worksheet.

Greatly appreciated, thank you again.

 

[JLGWhiz]

See if this is what you want

Sub t2()
Dim sh As Worksheet, nsh As Worksheet, lr As Long
Set sh = ActiveSheet
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
nsh.Name = "Print Summary"
sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy
nsh.Range("A1").PasteSpecial xlPasteValues
lr = nsh.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
Sheets("Checklist").UsedRange.SpecialCells(xlCellTypeVisible).Copy
nsh.Cells(lr + 1, 1).PasteSpecial xlPasteValues
    For i = 1 To nsh.UsedRange.Columns.Count
        nsh.Columns(i).ColumnWidth = sh.Columns(i).ColumnWidth
    Next
Application.CutCopyMode = False
End Sub

 

[Iceshade]

See if this is what you want

Sub t2()
Dim sh As Worksheet, nsh As Worksheet, lr As Long
Set sh = ActiveSheet
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
nsh.Name = "Print Summary"
sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy
nsh.Range("A1").PasteSpecial xlPasteValues
lr = nsh.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
Sheets("Checklist").UsedRange.SpecialCells(xlCellTypeVisible).Copy
nsh.Cells(lr + 1, 1).PasteSpecial xlPasteValues
    For i = 1 To nsh.UsedRange.Columns.Count
        nsh.Columns(i).ColumnWidth = sh.Columns(i).ColumnWidth
    Next
Application.CutCopyMode = False
End Sub

@JLGWhiz - Ok this is great and gives me enough to work with and flesh out bit more. Just one last request if I may please, how could I change this to instead create 2 different sheets as opposed to appending to the one? If it's too much trouble disregard, just trying to retain column widths for both, if I have them separated I could then print both worksheets to 1 PDF (I can do the PDF bit).

I can't tell you appreciative I am, this is a great learning for me !

 

[JLGWhiz]

I didn't test this but it should work to give you the two sheets. Post back if it hiccups.

Sub t2()
Dim sh As Worksheet, nsh As Worksheet, lr As Long
Set sh = ActiveSheet
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
nsh.Name = "Print Summary 1"
sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy
nsh.Range("A1").PasteSpecial xlPasteValues
    For i = 1 To nsh.UsedRange.Columns.Count
        nsh.Columns(i).ColumnWidth = sh.Columns(i).ColumnWidth
    Next
'lr = nsh.Cells.Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
Set nsh = Sheets.Add(After:=Sheets(Sheets.Count))
nsh.Name = "Print Summary 2"
Sheets("Checklist").UsedRange.SpecialCells(xlCellTypeVisible).Copy
nsh.Range("A1").PasteSpecial xlPasteValues
    For i = 1 To nsh.UsedRange.Columns.Count
        nsh.Columns(i).ColumnWidth = Sheets("Checklist").Columns(i).ColumnWidth
    Next
Application.CutCopyMode = False
End Sub