Open a workbook using vba and a cell reference

J

jondavis1987

Active Member
Joined
Dec 31, 2015
Messages
443
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
 
Sort by date Sort by votes
Is it solved.Also I can see that you are using destsht and dstsht both, make sure you use the same sheet name
 
Upvote 0

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
I did get it solved. the final code I went with seems to work.

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("E41").Copy
    destWB.Sheets(wsName).Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").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 = 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 I added that part in and now my overall final code is

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
    
 
    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("E41").Copy
    destWB.Sheets(wsName).Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").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 = 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
You must log in or register to reply here.

Similar threads

J
  • Solved
VBA Keeps Skipping a Paste
2
Replies
11
Views
755
jondavis1987
J
D
  • Solved
Copy/Paste Values multiple outputs with different sizes into one single Excel sheet using VBA
Replies
2
Views
512
daisylee
D
P
  • Solved
VBA to open file using Cell for the path
Replies
4
Views
626
Peter Davison
P
F
  • Solved
Copying and pasting onto mastersheet but files have different formats (need if statement help)
2
Replies
12
Views
947
NateSC
NateSC
Guna13
  • Question
How to Efficient way for create Multiple Workbooks
Replies
1
Views
156
Guna13
Guna13

Forum statistics

Threads
1,215,537
Messages
6,125,398
Members
449,222
Latest member
taner zz

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
Back
Top