Combining Worksheets - Finishing Details Required

[MissMisfit]

Help needed!

I have multiple sheets within a workbook that I use to input information for particular pieces of plant and the history of the items. I'm wanting to combine all of these sheets within one sheet for ease of printing (and so as to not waste paper). However, I'm wanting a way to do so without changing the sizing of any of the rows or columns as I'm wanting hidden items to stay hidden. And I want to reduce the amount of formatting I'm needing to do after every change. I can't combine all of these sheets into the workbook permanently as each sheet is used as a hyperlink on a larger database.

I would also like it if there's a way I can make this particular combined sheet automatically update my changes so I'm not having to run the macro each time I'm wanting to print it.

The latter isn't as much of a concern as the former though as I'm hiding items that are no longer relevant and I'm not wanting to go through each row and figure out on the master database what is no longer relevant to view but is still necessary to have.

The below is the VBA that I'm currently running (I borrowed this off of a different thread however, I can't figure out how to get it to do the above.

Any help would be greatly appreciated!


Sub PrintOnePage()
Dim wshTemp As Worksheet, wsh As Worksheet
Dim rngArr() As Range, c As Range
Dim i As Integer
Dim J As Integer


ReDim rngArr(1 To 1)
For Each wsh In ActiveWorkbook.Worksheets
i = i + 1
If i > 1 Then ' resize array
ReDim Preserve rngArr(1 To i)
End If


On Error Resume Next
Set c = wsh.Cells.SpecialCells(xlCellTypeLastCell)
If Err = 0 Then
On Error GoTo 0


'Prevent empty rows
Do While Application.CountA(c.EntireRow) = 0 _
And c.EntireRow.Row > 1
Set c = c.Offset(-1, 0)
Loop


Set rngArr(i) = wsh.Range(wsh.Range("A1"), c)
End If
Next wsh


'Add temp.Worksheet
Set wshTemp = Sheets.Add(after:=Worksheets(Worksheets.Count))


On Error Resume Next
With wshTemp
For i = 1 To UBound(rngArr)
If i = 1 Then
Set c = .Range("A1")
Else
Set c = _
ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell)
Set c = c.Offset(2, 0).End(xlToLeft) 'Skip one row
End If


'Copy-paste range (prevent empty range)
If Application.CountA(rngArr(i)) > 0 Then
rngArr(i).Copy c
End If
Next i
End With
On Error GoTo 0


Application.CutCopyMode = False ' prevent marquies


With ActiveSheet.PageSetup 'Fit to 1 page
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With


'Preview New Sheet
ActiveWindow.SelectedSheets.PrintPreview


'Print Desired Number of Copies
i = InputBox("Print how many copies?", "ExcelTips", 1)
If IsNumeric(i) Then
If i > 0 Then
ActiveSheet.PrintOut Copies:=i
End If
End If


'Delete temp.Worksheet?
If MsgBox("Delete the temporary worksheet?", _
vbYesNo, "ExcelTips") = vbYes Then
Application.DisplayAlerts = False
wshTemp.Delete
Application.DisplayAlerts = True
End If
End Sub