jondavis1987
Active Member
- Joined
- Dec 31, 2015
- Messages
- 443
- Office Version
- 2019
- Platform
- Windows
What's in asterisks will give me an error. Run-time error '91': Object variable or With block variable not set. This code has worked for me for over a year. I haven't changed anything and now i'm getting this error.
VBA Code:
ption 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\Aggregates\Stockpile Gradation\Stockpile Charts.xlsx"
Set destWB = ActiveWorkbook
' Unhide Sheet
destWB.Sheets("Sheet1").Visible = True
destWB.Sheets("Moistures").Visible = True
' Find last row of Sheet1 data in destination workbook
lastRow = destWB.Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1
' Copy Sheet1 data from source workbook to destination workbook
srcWB.ActiveSheet.Range("F5").Copy
destWB.Sheets("Sheet1").Range("A" & lastRow).Resize(14, 1).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("B4").Copy
destWB.Sheets("Sheet1").Range("D" & lastRow).Resize(14, 1).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("B5").Copy
destWB.Sheets("Sheet1").Range("E" & lastRow).Resize(14, 1).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("A12:A25").Copy
destWB.Sheets("Sheet1").Range("F" & lastRow).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("F12:F25").Copy
destWB.Sheets("Sheet1").Range("G" & lastRow).PasteSpecial xlPasteValues
' Find last row of Sheet1 data in destination workbook
lastRow = destWB.Sheets("Moistures").Cells(Rows.Count, "A").End(xlUp).Row + 1
' Copy Moistures data from source workbook to destination workbook
srcWB.ActiveSheet.Range("F5").Copy
destWB.Sheets("Moistures").Range("A" & lastRow).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("B4").Copy
destWB.Sheets("Moistures").Range("D" & lastRow).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("B5").Copy
destWB.Sheets("Moistures").Range("E" & lastRow).PasteSpecial xlPasteValues
srcWB.ActiveSheet.Range("F8").Copy
destWB.Sheets("Moistures").Range("F" & lastRow).PasteSpecial xlPasteValues
' Hide Sheet
destWB.Sheets("Sheet1").Visible = False
destWB.Sheets("Moistures").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 srcWB1 = ActiveWorkbook
' Set the name of the destination workbook
destName = Range("B1").Text
' Set the name of the destination worksheet
wsName = "Agg Gradations"
' Open destination workbook and capture it as destination workbook
Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Misc\Gradations Changes\" & destName & ".xlsm"
Set destWB1 = ActiveWorkbook
Dim rg As Range
Dim srcName As String
srcName = srcWB.ActiveSheet.Range("B5")
Application.DisplayAlerts = False
For Each rg In destWB1.Sheets(wsName).Range("A1:Z100") ' change the range here
If rg = srcName Then GoTo Found
Next rg
Found:
srcWB.ActiveSheet.Range("L12:L25").Copy
********** rg.Offset(1, 0).PasteSpecial xlPasteValues ***********
' Save changes and close destination workbook
destWB1.Close SaveChanges:=True
' Export source workbook to PDF
With srcWB
Dim LocationName As String
fName = ActiveSheet.Range("A2").Value
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Jdavis\Dropbox\Quality Control\Aggregates\Stockpile Gradation\" & fName, Quality:=xlQualityStandard, _
includeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
End Sub