Copy value in odd cells of closed workbook->paste into next blank row of master sheet

David Trinco

New member
Joined
Jun 5, 2019
Messages
5
Reaction score
0
Points
0
Excel Version(s)
Excel 2010
Copy value in odd cells of closed workbook->paste into next blank row of master sheet

Hi guys,

Thank you for having me at Excel Guru.

I thought maybe you could assist as I have been having some issues with the following VBA coding.

I know I've got something wrong somewhere but I don't know where exactly and it's driving me insane.

It used to work with copy paste, but with so many lines it seems to create an error after a while with an exception.

I've changed the code so many times that I'm afraid I can't remember the exact error code.

Below is the current code I have, please can you advise if you can see why it's not working or what I need to change to make it work:

Essentially I'm accessing a closed workbook but getting the user to access it via a application.getopenfilename. This then opens the file in the background and allows to copy specific values as listed in the coding below and paste it in the next available row in the master spreadsheet. As I mentioned copy paste worked but only temporarily and then kept bugging which wouldn't work for the users. They want the information from a closed workbook to populate in a master sheet so that is effectively what I'm trying to achieve below.

I know I've gone wrong, but I can for the life of me figure it out. Possibly with the range or the last row info below.

Any help would be greatly appreciated. Thanks :)
Code:
Sub GetInfo()
Application.ScreenUpdating = False
Dim excel As excel.Application
Dim xFileName As Variant
Dim wb As excel.Workbook
Dim sht As excel.Worksheet
Dim LastRow As Long
With Workbooks("Test.xlsm").Worksheets("Sheet1")
    LastRow = .Range("A" & Rows.Count).End(xlUp).Row
End With
Set excel = CreateObject("excel.Application")
excel.Visible = False
xFileName = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", 1, "Select a Workbook")
If xFileName = False Then Exit Sub
Set wb = excel.Workbooks.Open(xFileName)
Set sht = wb.Worksheets("Quotation")
With sht
    .Range("H4").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "A").Value
    .Range("E13").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "B").Value
    .Range("G13").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "C").Value
    .Range("E5").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "D").Value
    .Range("B5").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "F").Value
    .Range("B23").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "G").Value
    .Range("F40").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "I").Value
    .Range("F41").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "J").Value
    .Range("F42").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "K").Value
    .Range("F43").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "L").Value
    .Range("F44").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "M").Value
    .Range("F45").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "N").Value
    .Range("F46").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "O").Value
    .Range("F47").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "P").Value
    .Range("F48").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "Q").Value
    .Range("F49").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "R").Value
    .Range("E15").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "T").Value
    .Range("J53").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "U").Value
    .Range("G11").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "V").Value
    .Range("B31").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "X").Value
End With
wb.Close
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Hi and welcome
in the future please warp code with code tags ( select code click the #button)
Thanks
 
I suspect the lines like :
.Range("H4").Value = Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "A").Value
(which write to the Quotation sheet) should be more like:
Workbooks("Test.xlsm").Worksheets("Sheet1").Cells(LastRow, "A").Value = .Range("H4").Value

Aside from that, test:
Code:
Sub GetInfo()
Application.ScreenUpdating = False
Dim excel As excel.Application
Dim xFileName As Variant
Dim wb As excel.Workbook
Dim sht As excel.Worksheet, DestnSht
Dim LastRow As Long
Set DestnSht = Workbooks("Test.xlsm").Worksheets("Sheet1")
LastRow = DestnSht.Range("A" & Rows.Count).End(xlUp).Row + 1 'note the +1
Set excel = CreateObject("excel.Application")
excel.Visible = False
xFileName = Application.GetOpenFilename("Excel Files (*.xlsx), *.xlsx", 1, "Select a Workbook")
If xFileName = False Then Exit Sub
Set wb = excel.Workbooks.Open(xFileName)
Set sht = wb.Worksheets("Quotation")
With sht
  DestnSht.Cells(LastRow, "A").Resize(, 4).Value = Array(.Range("H4").Value, .Range("E13").Value, .Range("G13").Value, .Range("E5").Value)
  DestnSht.Cells(LastRow, "F").Resize(, 2).Value = Array(.Range("B5").Value, .Range("B23").Value)
  DestnSht.Cells(LastRow, "I").Resize(, 10).Value = Array(.Range("F40").Value, .Range("F41").Value, .Range("F42").Value, .Range("F43").Value, .Range("F44").Value, .Range("F45").Value, .Range("F46").Value, .Range("F47").Value, .Range("F48").Value, .Range("F49").Value)
  DestnSht.Cells(LastRow, "T").Resize(, 3).Value = Array(.Range("E15").Value, .Range("J53").Value, .Range("G11").Value)
  DestnSht.Cells(LastRow, "X").Value = .Range("B31").Value
End With
wb.Close
Application.ScreenUpdating = True
End Sub
 
Last edited:
Hi Pecoflyer, thank you for your advice and I sent you a private message with a thank you for all your help in posting my query :)

Hi p45cal, thank you so much for your coding assistance. Absolutely brilliant, simple (in its elegance, obviously the coding knowledge is only acquired through sheer hard work, dedication and having a keen, astute mind) and efficient. You're a genius and thank you so much for all your help :).

Wishing you both a lovely rest of day.

Cheers,

David
 
Last edited:
Back
Top