Results 1 to 4 of 4

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

  1. #1
    Seeker David Trinco's Avatar
    Join Date
    Jun 2019
    Posts
    5
    Articles
    0
    Excel Version
    Excel 2010

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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 Pecoflyer; 2019-06-06 at 04:42 PM. Reason: Added code tags

  2. #2
    Administrator Pecoflyer's Avatar
    Join Date
    Oct 2011
    Location
    Brussels Belgium
    Posts
    1,656
    Articles
    0
    Excel Version
    2010 on Xubuntu
    Hi and welcome
    in the future please warp code with code tags ( select code click the #button)
    Thanks
    Thank you Ken for this secure forum.

  3. #3
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,551
    Articles
    0
    Excel Version
    365
    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 by p45cal; 2019-06-07 at 05:26 PM.

  4. #4
    Seeker David Trinco's Avatar
    Join Date
    Jun 2019
    Posts
    5
    Articles
    0
    Excel Version
    Excel 2010

    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 by David Trinco; 2019-06-10 at 11:37 AM.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •