Option Explicit
Sub Open_Workbook()
Dim srcWB As Workbook
Dim destWB As Workbook
Dim fName As String
Dim lastRow As Long
' Capture current workbook as source workbook
Set srcWB = Workbooks("Superpaves")
' Open destination workbook and capture it as destination workbook
Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Misc\Yearly HMA Charts.xlsx"
Set destWB = Workbooks("Yearly HMA Charts")
' Unhide_Multiple_Sheets()
destWB.Sheets("Samples").Visible = True
destWB.Sheets("Sieves").Visible = True
' Find last row of Sieve data in destination workbook
lastRow = destWB.Sheets("Sieves").Cells(Rows.Count, "G").End(xlUp).Row + 1
' Copy Sieve data from source workbook to destination workbook
srcWB.Sheets("A").Range("G20").Copy
destWB.Sheets("Sieves").Range("A" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("H20").Copy
destWB.Sheets("Sieves").Range("B" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G3").Copy
destWB.Sheets("Sieves").Range("C" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G5").Copy
destWB.Sheets("Sieves").Range("D" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("B6").Copy
destWB.Sheets("Sieves").Range("E" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("A10:A21").Copy
destWB.Sheets("Sieves").Range("F" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("D10:D21").Copy
destWB.Sheets("Sieves").Range("G" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G21:G32").Copy
destWB.Sheets("Sieves").Range("H" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("H21:H32").Copy
destWB.Sheets("Sieves").Range("I" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("D22").Copy
destWB.Sheets("Sieves").Range("J" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G47").Copy
destWB.Sheets("Sieves").Range("K" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("H47").Copy
destWB.Sheets("Sieves").Range("L" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("C53").Copy
destWB.Sheets("Sieves").Range("M" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G48").Copy
destWB.Sheets("Sieves").Range("N" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("H48").Copy
destWB.Sheets("Sieves").Range("O" & lastRow).Resize(12, 1).PasteSpecial xlPasteValues
' Find last row of Samples data in desitnation workbook
lastRow = destWB.Sheets("Samples").Cells(Rows.Count, "A").End(xlUp).Row + 1
' Copy Samples data from source workbook to destination workbook
srcWB.Sheets("A").Range("G20").Copy
destWB.Sheets("Samples").Range("A" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("H20").Copy
destWB.Sheets("Samples").Range("B" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G3").Copy
destWB.Sheets("Samples").Range("C" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("G5").Copy
destWB.Sheets("Samples").Range("D" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("B6").Copy
destWB.Sheets("Samples").Range("E" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("Sheet2").Range("D31").Copy
destWB.Sheets("Samples").Range("F" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("Sheet2").Range("E31").Copy
destWB.Sheets("Samples").Range("G" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("Sheet2").Range("F31").Copy
destWB.Sheets("Samples").Range("H" & lastRow).PasteSpecial xlPasteValues
' Hide_Multiple_Sheets()
destWB.Sheets("Samples").Visible = False
destWB.Sheets("Sieves").Visible = False
' Save changes and close destination workbook
destWB.Close SaveChanges:=True
Dim srcWB1 As Workbook
Dim destWB1 As Workbook
Dim fName1 As String
Dim lastRows As Long
Dim destName As String
Dim wsName As String
' Capture current workbook as source workbook
Set srcWB = Workbooks("Superpaves")
' Set the name of the destination workbook
destName = srcWB.Sheets("A").Range("F8").Text
' Set the name of the destination worksheet
wsName = srcWB.Sheets("A").Range("B6").Text
' Open destination workbook and capture it as destination workbook
Workbooks.Open "C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Mold Heights\" & destName & ".xlsx"
Set destWB = Workbooks(destName)
' Error Route
On Error GoTo ErrHandler:
Worksheets(wsName).Activate
' Find last row of data in desired worksheet of destination workbook
lastRow = destWB.Sheets(wsName).Cells(Rows.Count, "A").End(xlUp).Row + 1
' Copy Mold Heights data from source workbook to destination workbook
srcWB.Sheets("A").Range("G3").Copy
destWB.Sheets(wsName).Range("A" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("E46").Copy
destWB.Sheets(wsName).Range("B" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("D22").Copy
destWB.Sheets(wsName).Range("C" & lastRow).PasteSpecial xlPasteValues
' Save changes and close destination workbook
destWB.Close SaveChanges:=True
' Export source workbook to PDF
With srcWB
fName = srcWB.Sheets("A").Range("A!F19").Value
Sheets(Array("A", "Sheet2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, _
openafterpublish:=True, ignoreprintareas:=False
End With
Exit Sub
ErrHandler:
If Err.Number = 9 Then
' sheet does not exist, so create it
Worksheets.Add.Name = wsName
destWB.Sheets(wsName).Range("A1").Value = "Date"
destWB.Sheets(wsName).Range("B1").Value = "Mold Height"
destWB.Sheets(wsName).Range("C1").Value = "AC"
destWB.Sheets(wsName).Range("F2").Value = "Avg Height"
destWB.Sheets(wsName).Range("F3").Value = "Avg AC"
destWB.Sheets(wsName).Range("G2").Value = "=Average(B:B)"
destWB.Sheets(wsName).Range("G3").Value = "=Average(C:C)"
destWB.Sheets(wsName).Range("A1", "A5000").NumberFormat = "mm/dd/yyyy"
destWB.Sheets(wsName).Range("B1", "B5000").NumberFormat = "0.0"
destWB.Sheets(wsName).Range("C1", "C5000").NumberFormat = "0.00"
' Borders
Range("F2:G3").Select
Range("G3").Activate
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveSheet.ListObjects.Add(xlSrcRange, destWB.Sheets(wsName).Range("$A$1:$C$1"), , xlYes).Name = wsName
' Find last row of data in desired worksheet of destination workbook
lastRow = destWB.Sheets(wsName).Cells(Rows.Count, "A").End(xlUp).Row
' Copy Mold Heights data from source workbook to destination workbook
srcWB.Sheets("A").Range("G3").Copy
destWB.Sheets(wsName).Range("A" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("E46").Copy
destWB.Sheets(wsName).Range("B" & lastRow).PasteSpecial xlPasteValues
srcWB.Sheets("A").Range("D22").Copy
destWB.Sheets(wsName).Range("C" & lastRow).PasteSpecial xlPasteValues
' Autofit Columns
destWB.Sheets(wsName).Columns("A:G").AutoFit
' Save changes and close destination workbook
destWB.Close SaveChanges:=True
' Export source workbook to PDF
With srcWB
fName = srcWB.Sheets("A").Range("A!F19").Value
Sheets(Array("A", "Sheet2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\" & Environ("username") & "\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, _
openafterpublish:=True, ignoreprintareas:=False
End With
End If
End Sub