PDA

View Full Version : [SOLVED:] Combining Data from multiple worksheets to a printable worksheet


RalphMHill
02-09-2017, 03:58 PM
I am trying to setup a macro which will copy data from multiple tabs in my workbook onto one tab for Printing.

18306

I have a workbook (Materials.xlsm) with 8 tabs:
Main, Tab_A, Tab_B, Tab_C, Tab_D, Tab_E, Tab_F, Tab_G

I want to copy the data from Tabs A-G onto the Main Tab, do the Sub Total. Then set the sheet to be printed and/or Saved as a PDF.
All the tabs have a Formula in the Sub-Total column (except the Main tab).

I am currently do this by hand which takes a long time.
If you need any more information, please let me know

Any and all suggestions will be appreciated
JBeaucaire
02-09-2017, 05:35 PM
Something like this:


Option Explicit

Sub CopyToMain()
Dim ws As Worksheet, NR As Long, LR As Long
Dim wsMain As Worksheet, fPATH As String


fPATH = "C:\TEMP\PDF\" 'path to save,remember the final \ in this string
Set wsMain = ThisWorkbook.Sheets("Main")


With wsMain
LR = .Range("AM" & .Rows.Count).End(xlUp).Row
If LR > 4 Then
.Rows("6:" & LR + 10).EntireRow.RowHeight = 15
.Range("A5:A" & LR).EntireRow.Clear
End If
NR = 6
End With


For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsMain.Name Then
With ws
LR = .Range("F" & .Rows.Count).End(xlUp).Row
If LR > 4 Then
.Range("A6:BA" & LR).Copy wsMain.Range("A" & NR)
NR = wsMain.Range("A" & Rows.Count).End(xlUp).Row + 1
End If
End With
End If
Next ws
NR = NR + 1
With wsMain
.Range("A6:D6").Copy .Range("A7:D" & NR)
With .Range("A6:A" & NR)
.Formula = "=ROW(A1)"
.Value = .Value
End With
With .Range("AM" & NR)
.Resize(, 5).Merge
.Borders.Weight = xlThin
.Value = "TOTAL"
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

With .Range("AT" & NR)
.Resize(, 8).Merge
.FormulaR1C1 = "=SUM(R6C:R[-1]C)"
.Font.Bold = True
.Borders.Weight = xlThin
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.EntireRow.RowHeight = 27
End With

Application.PrintCommunication = False
With .PageSetup
.PrintArea = "$A$1:$BA$" & NR + 1
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True

If MsgBox("Print to PDF?", vbYesNo, "PRINT") = vbYes Then
wsMain.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPATH & .[F2].Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
End With


End Sub
RalphMHill
02-12-2017, 01:53 PM
Jerry

Is there a way to change this so the Total is done at the top of the Page(ie. the word TOTAL is in merged cells A6:AQ6, and the Formula is in merged cells AT6:BA6)?
RalphMHill
02-12-2017, 01:56 PM
18342
JBeaucaire
02-12-2017, 07:39 PM
Option Explicit

Sub CopyToMain()
Dim ws As Worksheet, NR As Long, LR As Long
Dim wsMain As Worksheet, fPATH As String

fPATH = &quot;C:\TEMP\PDF\&quot; &#39;path to save,remember the final \ in this string
Set wsMain = ThisWorkbook.Sheets(&quot;Main&quot;)

With wsMain
LR = .Range(&quot;A&quot; & .Rows.Count).End(xlUp).Row
If LR > 4 Then
.Rows(&quot;8:&quot; & LR + 10).EntireRow.RowHeight = 15
.Range(&quot;A8:A&quot; & LR).EntireRow.Clear
End If
NR = 8
End With
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> wsMain.Name Then
With ws
LR = .Range(&quot;F&quot; & .Rows.Count).End(xlUp).Row
If LR > 4 Then
.Range(&quot;A6:BA&quot; & LR).Copy wsMain.Range(&quot;A&quot; & NR)
NR = wsMain.Range(&quot;A&quot; & Rows.Count).End(xlUp).Row + 1
End If
End With
End If
Next ws

NR = NR - 1
With wsMain
.Range(&quot;A8:D8&quot;).Copy .Range(&quot;A9:D&quot; & NR)
With .Range(&quot;A8:A&quot; & NR)
.Formula = &quot;=ROW(A1)&quot;
.Value = .Value
End With

Application.PrintCommunication = False
With .PageSetup
.PrintArea = &quot;$A$1:$BA$&quot; & NR + 1
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True

If MsgBox(&quot;Print to PDF?&quot;, vbYesNo, &quot;PRINT&quot;) = vbYes Then
wsMain.ExportAsFixedFormat Type:=xlTypePDF, Filename:=fPATH & .[F2].Value & &quot;.pdf&quot;, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
End With
End Sub
RalphMHill
02-13-2017, 08:48 AM
Jerry,

Thank you this works Great!!!!:cloud9:
JBeaucaire
02-13-2017, 12:52 PM
Great! Can you mark this thread as SOLVED then using the Thread Tools above post #1? Thanks.