Open a workbook using vba and a cell reference

J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
425
Office Version
  1. 2019
Platform
  1. Windows
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
    
'   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("Sheet2").Range("J18:J25").Copy
    destWB.Sheets("Sieves").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G29:G36").Copy
    destWB.Sheets("Sieves").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39:H46").Copy
    destWB.Sheets("Sieves").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39:F46").Copy
    destWB.Sheets("Sieves").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29:F36").Copy
    destWB.Sheets("Sieves").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H29:H36").Copy
    destWB.Sheets("Sieves").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("A10:A17").Copy
    destWB.Sheets("Sieves").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G21:G28").Copy
    destWB.Sheets("Sieves").Range("H" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H21:H28").Copy
    destWB.Sheets("Sieves").Range("I" & lastRow).PasteSpecial xlPasteValues
'   Find last row of AC data in destination workbook
    lastRow = destWB.Sheets("AC").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
'   Copy AC data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("AC").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("AC").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("AC").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("AC").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H37").Copy
    destWB.Sheets("AC").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("AC").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G47").Copy
    destWB.Sheets("AC").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H47").Copy
    destWB.Sheets("AC").Range("H" & lastRow).PasteSpecial xlPasteValues
'   Find last row of Voids data in desitnation workbook
    lastRow = destWB.Sheets("Voids").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
'   Copy Voids data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("Voids").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("Voids").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("Voids").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("Voids").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H38").Copy
    destWB.Sheets("Voids").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("C48").Copy
    destWB.Sheets("Voids").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G48").Copy
    destWB.Sheets("Voids").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H48").Copy
    destWB.Sheets("Voids").Range("H" & lastRow).PasteSpecial xlPasteValues
    
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True
'   Export source workbook to PDF
    With srcWB
        fName = 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

So that's the code that I have. So just after

Code: 
 '   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

and before

Code: 
'   Export source workbook to PDF
    With srcWB
        fName = 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
[/CODE]

I would like it to open a workbook from a cell reference. The location would be C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Heights\(Cell A7).

I have some pasting to do in there and I can't seem to think straight on this today
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
Sort by date Sort by votes
J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
425
Office Version
  1. 2019
Platform
  1. Windows
I would also need the worksheet in the destination workbook to be from a cell reference of A7
 
Upvote 0
sunny102

sunny102

Board Regular
Joined
Dec 19, 2016
Messages
102
You can use the following code:

shtname=Range("A7") //this will get the workbook name and sheet name which I am assuming is same


//this will opne the file
inputfile = "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Heights" & shtname


Set wb = Workbooks.Open(inputfile)


Set destsht = wb.Sheets(shtname)
 
Upvote 0
J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
425
Office Version
  1. 2019
Platform
  1. Windows
I'm sorry, I was using two different cells as references and I screwed up when making the example. So here's about what I'm trying to do.

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
    
'   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("Sheet2").Range("J18:J25").Copy
    destWB.Sheets("Sieves").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G29:G36").Copy
    destWB.Sheets("Sieves").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39:H46").Copy
    destWB.Sheets("Sieves").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39:F46").Copy
    destWB.Sheets("Sieves").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29:F36").Copy
    destWB.Sheets("Sieves").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H29:H36").Copy
    destWB.Sheets("Sieves").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("A10:A17").Copy
    destWB.Sheets("Sieves").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G21:G28").Copy
    destWB.Sheets("Sieves").Range("H" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H21:H28").Copy
    destWB.Sheets("Sieves").Range("I" & lastRow).PasteSpecial xlPasteValues
'   Find last row of AC data in destination workbook
    lastRow = destWB.Sheets("AC").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
'   Copy AC data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("AC").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("AC").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("AC").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("AC").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H37").Copy
    destWB.Sheets("AC").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("AC").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G47").Copy
    destWB.Sheets("AC").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H47").Copy
    destWB.Sheets("AC").Range("H" & lastRow).PasteSpecial xlPasteValues
'   Find last row of Voids data in desitnation workbook
    lastRow = destWB.Sheets("Voids").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
'   Copy Voids data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("Voids").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("Voids").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("Voids").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("Voids").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H38").Copy
    destWB.Sheets("Voids").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("C48").Copy
    destWB.Sheets("Voids").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G48").Copy
    destWB.Sheets("Voids").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H48").Copy
    destWB.Sheets("Voids").Range("H" & lastRow).PasteSpecial xlPasteValues
    
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True
Sub Open_Workbook()
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
      Dim LocationName As String
     LocationName = Range("'A'!F8").Value
'   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\Mold Height\" & LocationName"
    Set destWB = ActiveWorkbook
    
'   Find last row of Sieve data in destination workbook
    lastRow = destWB.Sheets("B6").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("B6").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("E41").Copy
    destWB.Sheets("B6").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("B6").Range("C" & lastRow).PasteSpecial xlPasteValues
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

'   Export source workbook to PDF
    With srcWB
        fName = 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

Here is where I'm not sure what to do

Code: 
Sub Open_Workbook()
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
      Dim LocationName As String
     LocationName = Range("'A'!F8").Value
'   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\Mold Height\" & LocationName"
    Set destWB = ActiveWorkbook
    
'   Find last row of Sieve data in destination workbook
    lastRow = destWB.Sheets("B6").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("B6").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("E41").Copy
    destWB.Sheets("B6").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("B6").Range("C" & lastRow).PasteSpecial xlPasteValues
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

The B6 in
Code: 
destWB.Sheets("B6").Range("C" & lastRow).PasteSpecial xlPasteValues
is a cell reference to b6 from sheet "A" of the source workbook.
So I need that code to open a workbook at
Code: 
C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Height\" & LocationName"
With Location Name being referenced from F8 of Sheet A in the source workbook
 
Upvote 0
sunny102

sunny102

Board Regular
Joined
Dec 19, 2016
Messages
102
I didn't get you. Can you be a bit more clear. From what I have understood is you can use a variable say ln and store the value from sheet A of source workbook as follows:

ln=Sheets("A").Range(F8")

and then you can use ln anywhere to open a new workbook.
 
Upvote 0
J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
425
Office Version
  1. 2019
Platform
  1. Windows
Code: 
Sub Open_Workbook()
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
      Dim LocationName As String
     LocationName = Range("'A'!F8").Value
'   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\Mold Height" & LocationName"
    Set destWB = ActiveWorkbook
    
'   Find last row of Sieve data in destination workbook
    lastRow = destWB.Sheets("B6").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("B6").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("E41").Copy
    destWB.Sheets("B6").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("B6").Range("C" & lastRow).PasteSpecial xlPasteValues
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True

That's the code that I have inside of a macro that's significantly bigger. I'm trying to open up a workbook from a cell reference. I need it to open up Code:
C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Height" & LocationName"
and the cell reference for the location name is F8 of the source workbook.
Let's say cell f8 says NP or SP
C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Height\NP.xlsx
or C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Height\SP.xlsx
is what I want it to open
My destWB.sheets is a name that's referenced in B6 of my source workbook and I don't know how to set that up either So if B6 of sheet A in my sourceworkbook says 3011-EST-1604 I need my destWB.sheets set to Sheet "3011-EST-1604"
 
Last edited:
Upvote 0
sunny102

sunny102

Board Regular
Joined
Dec 19, 2016
Messages
102
Ok, you can use the following code

LocationName=Range("F8") & ".xlsx"
shtname=Range("B6")
destfile= "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Height" & LocationName


Set wb = Workbooks.Open(destfile)
Set destsht = wb.Sheets(shtname)


and instead of destWB.Sheets("B6") use dstsht and instead of destWB.Close SaveChanges:=True use wb.close

Try this and let me know of you stuck somewhere. And if you get any error just attach your file here
 
Upvote 0
J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
425
Office Version
  1. 2019
Platform
  1. Windows
it says ambiguous name detected and highlights
Code: 
 Sub Open_Workbook()

So this is what the code as a whole looks like now. I have bolded where it is highlighting



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
    
'   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("Sheet2").Range("J18:J25").Copy
    destWB.Sheets("Sieves").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G29:G36").Copy
    destWB.Sheets("Sieves").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39:H46").Copy
    destWB.Sheets("Sieves").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39:F46").Copy
    destWB.Sheets("Sieves").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29:F36").Copy
    destWB.Sheets("Sieves").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H29:H36").Copy
    destWB.Sheets("Sieves").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("A10:A17").Copy
    destWB.Sheets("Sieves").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G21:G28").Copy
    destWB.Sheets("Sieves").Range("H" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H21:H28").Copy
    destWB.Sheets("Sieves").Range("I" & lastRow).PasteSpecial xlPasteValues
'   Find last row of AC data in destination workbook
    lastRow = destWB.Sheets("AC").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
'   Copy AC data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("AC").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("AC").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("AC").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("AC").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H37").Copy
    destWB.Sheets("AC").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("AC").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G47").Copy
    destWB.Sheets("AC").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H47").Copy
    destWB.Sheets("AC").Range("H" & lastRow).PasteSpecial xlPasteValues
'   Find last row of Voids data in desitnation workbook
    lastRow = destWB.Sheets("Voids").Cells(Rows.Count, "A").End(xlUp).Row + 1
    
'   Copy Voids data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("Voids").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("Voids").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("Voids").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("Voids").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H38").Copy
    destWB.Sheets("Voids").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("C48").Copy
    destWB.Sheets("Voids").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G48").Copy
    destWB.Sheets("Voids").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H48").Copy
    destWB.Sheets("Voids").Range("H" & lastRow).PasteSpecial xlPasteValues
    
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True
[COLOR=#000000][B]Sub Open_Workbook()[/B][/COLOR]
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
      Dim LocationName As String
     LocationName = Range("F8") & ".xlsx"
      shtname = Range("B6")
 destfile = "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Mold Height" & LocationName

Set wb = Workbooks.Open(destfile)
Set destsht = wb.Sheets(shtname)
     
'   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\Mold Height" & LocationName
    Set destWB = ActiveWorkbook
    
'   Find last row of Sieve data in destination workbook
    lastRow = destWB.Sheets("B6").Cells(Rows.Count, "A").End(xlUp).Row + 1
'   Copy Mold Heights data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G3").Copy
    dstsht("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("E41").Copy
    dstsht("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    dstsht("C" & lastRow).PasteSpecial xlPasteValues
'   Save changes and close destination workbook
    wb.Close SaveChanges:=True

'   Export source workbook to PDF
    With srcWB
        fName = 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
 
Upvote 0
M

MattH1

Board Regular
Joined
Jul 15, 2016
Messages
174
Hey jondavis,

It looks like you just doubled your code, so it has two Sub() statements before an End Sub statement.

Check your code again, make sure you didn't double everything.
 
Upvote 0
You must log in or register to reply here.

Similar threads

J
  • Question
VBA to create a worksheet named by cell vaue if error
Replies
9
Views
601
jondavis1987
J
J
  • Locked
  • Question
VBA Error 1004 on second time running the code
Replies
1
Views
944
RoryA
RoryA
J
  • Solved
Vba Range.Value = Range.Value not working
2
Replies
10
Views
2K
Fluff
Fluff
J
  • Solved
VBA Copy range from another workbook if cell is not blan
Replies
6
Views
230
Joe4
Joe4
J
  • Question
Error in VBA I have been running for a year
2
Replies
11
Views
542
jondavis1987
J

Forum statistics

Threads
1,191,165
Messages
5,985,034
Members
439,935
Latest member
Monty238

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top