jondavis1987
Active Member
- Joined
- Dec 31, 2015
- Messages
- 443
- Office Version
- 2019
- Platform
- Windows
Below is the full code of the macro i'm using
Specifically in that code there is a bit that opens a workbook called Mold Heights, finds a worksheet based off of a cell value. Below is the specific code. How do I modify this where if there's not a worksheet that matches wsName it will automatically create one?
VBA Code:
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 = ActiveWorkbook
' Open destination workbook and capture it as destination workbook
Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Misc\Yearly HMA Charts.xlsx"
Set destWB = ActiveWorkbook
' 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 = ActiveWorkbook
' Set the name of the destination workbook
destName = Range("F8").Text
' Set the name of the destination worksheet
wsName = Range("B6").Text
' Open destination workbook and capture it as destination workbook
Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Heights\" & destName & ".xlsx"
Set destWB = ActiveWorkbook
' 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
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, Quality:=xlQualityStandard, _
includeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
End Sub
Specifically in that code there is a bit that opens a workbook called Mold Heights, finds a worksheet based off of a cell value. Below is the specific code. How do I modify this where if there's not a worksheet that matches wsName it will automatically create one?
VBA Code:
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 = ActiveWorkbook
' Set the name of the destination workbook
destName = Range("F8").Text
' Set the name of the destination worksheet
wsName = Range("B6").Text
' Open destination workbook and capture it as destination workbook
Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Heights\" & destName & ".xlsx"
Set destWB = ActiveWorkbook
' 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