Results 1 to 4 of 4
  1. #1
    New Lounger
    Join Date
    Apr 2016
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts

    VBA Copy data from active worksheet to closed workbook

    Hi,
    I'm trying to make my invoicing system a bit more user-friendly. I currently have a template which creates invoices and receipts for jobs and saves the invoice data into a register. The invoice/receipt for each job is saved into its own xls file, where users can then create PDFs.
    I've recently realised that it'd be great to also have a receipt register to track everything.

    What I'm trying to do is create a button which will copy data from certain cells (F6, F3, C13, C14 and F31) on the "Receipt" sheet in the current workbook to the next available row on the "Receipt Register" sheet on the master workbook (closed).

    Receipt:
    receipt.jpg

    Register:
    receipt_register.jpg

    I'm relatively new to VBA, but have adapted code I've found online in order to get something similar to what I need. Can someone please help/edit it to make it work?
    If you could explain some of what's happening in the code, that'd be great as I'm still learning.

    Code:
    Sub ReceiptRegister_Click()    Dim wbTarget         As Workbook 'workbook where the data is to be pasted
        Dim wbThis           As Workbook 'workbook from where the data is to copied
        
        'set to the current active workbook (the source book)
        Set wbThis = ActiveWorkbook
        'open a workbook that has same name as the sheet name
        Set wbTarget = Workbooks.Open("C:\Users\Me\AppData\Roaming\Microsoft\Templates\Invoice template v3.xltm")
        
        'activate the source book
        wbThis.Activate
        
    'Debug is having issues with this line
        'copy the range from source book
        wbThis.Array(Range("F6"), Range("F3"), Range("C13"), Range("C14"), Range("F31")).Copy
        
    'Not sure how to get from the above to pasting it in the register
        ' Figure out which row is the next row
        NextRow = wbTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
    
       'paste the data on the target book
       wbTarget.Range("A1").PasteSpecial
        
       'save the target book
       wbTarget.Save
        
       'close the workbook
       wbTarget.Close
        
    End Sub
    Thanks in advance.

  2. #2
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,827
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi mand

    Welcome to the Lounge as a new poster.

    Here's some code that may do what you require.
    I've put the code into a module in the attached file.
    Test it with some sample data first!
    (You should create a test folder with some test sample files etc etc etc)

    Let us know how you get on.

    Code:
    Sub updateReceiptRegister()
    
    Dim wbTarget         As Workbook 'workbook where the data is to be pasted
    Dim wbThis           As Workbook 'workbook from where the data is to copied
    
    '******************************************
    'DEFINE COPY-FROM SOURCE WORKBOOK ..
    '******************************************
    Set wbThis = ActiveWorkbook                 'set to the current active workbook
    
    '******************************************
    'DEFINE RECEIPTS REGISTER FILE HERE..       '### ENTER YOUR FILE LOCATIONS HERE ###
    '******************************************
    zReceiptFile = "ReceiptRegister.xlsx"       '<< enter name of Receipts Register file
    zReceiptFolder = "C:\myfolder\"             '<< e.g. "E:\FY2016\accounts\invoices\"
    zFetch = zReceiptFolder & zReceiptFile      'full path and filename
    
    '******************************************
    'CHECK RECEIPTS REGISTER FILE EXISTS..
    '******************************************
    If Dir(zFetch) = "" Then                    'missing file!
    saywhat = "Cannot find Receipts Register file!"         'message box text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    saywhat = saywhat & "Expected filename:" & vbCr         'add text
    saywhat = saywhat & zReceiptFile                        'add text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    saywhat = saywhat & "Expected folder location:" & vbCr  'add text
    saywhat = saywhat & zReceiptFolder                      'add text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    btns = vbOKOnly + vbExclamation             'message box buttons
    boxtitle = "Update Receipts Register"       'message box heaading
    answer = MsgBox(saywhat, btns, boxtitle)    'display message box
    
    Exit Sub                                    'nothing else to do
    End If                                      'end of test for missing file
    '******************************************
    'GET REQUIRED DATA FOR THE UPDATE..
    '******************************************
    wbThis.Activate
    'it would be better to used named ranges assigned to the cells
    'rather than direct cell addresses; it would be more flexible
    'if structure changes were made to the Invoice sheet.
    
    zInvoiceNumber = [F3]
    zPmtReceivedDate = [F6]
    zCompanyName = [C13]
    zClientName = [C14]
    zGrandTotal = [F31]
    
    '******************************************
    'CHECK REQUIRED DATA IS OK..
    '******************************************
    'can make additional checks here
    'e.g. make sure required entries are not blank etc etc
    
    
    
    '******************************************
    'OPEN RECEIPTS REGISTER FILE FOR UPDATING
    '******************************************
    Application.DisplayAlerts = False           'ignore alert if file being used elsewhere
    Set wbTarget = Workbooks.Open(zFetch)       'open file, and assign shortcut to it
    '******************************************
    'CHECK READ-WRITE ACCESS TO RECEIPTS REGISTER
    '******************************************
    If wbTarget.ReadOnly = True Then            'this file is currently being used
    saywhat = "The Register file is being used elsewhere."  'message box text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    saywhat = saywhat & "Try again in a few minutes" & vbCr 'add text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    btns = vbOKOnly + vbInformation             'message box buttons
    boxtitle = "Update Receipts Register"       'message box heaading
    answer = MsgBox(saywhat, btns, boxtitle)    'display message box
    
    Exit Sub                                    'nothing else to do
    End If
    '******************************************
    'UPDATE RECEIPTS REGISTER FILE..
    '******************************************
    wbTarget.Activate
    r = Cells(Rows.Count, 1).End(xlUp).Row + 1  'next available row for update
    Cells(r, "A") = zPmtReceivedDate
    Cells(r, "B") = zInvoiceNumber
    Cells(r, "C") = zCompanyName
    Cells(r, "D") = zClientName
    Cells(r, "E") = zGrandTotal
    '******************************************
    'CLOSE UPDATED RECEIPTS REGISTER FILE..
    '******************************************
    wbTarget.Close savechanges:=True
    
    '******************************************
    'UPDATE STATUS TO SHOW DATA HAS BEEN POSTED..
    '******************************************
    wbThis.Activate
    [B10] = "Receipt Register has been updated"
    
    
    End Sub
    report back here if you need further help.

    zeddy
    Attached Files Attached Files
    Last edited by zeddy; 2016-04-30 at 06:12.

  3. #3
    New Lounger
    Join Date
    Apr 2016
    Posts
    2
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by zeddy View Post
    Hi mand

    Welcome to the Lounge as a new poster.

    Here's some code that may do what you require.
    I've put the code into a module in the attached file.
    Test it with some sample data first!
    (You should create a test folder with some test sample files etc etc etc)

    Let us know how you get on.

    Code:
    Sub updateReceiptRegister()
    
    Dim wbTarget         As Workbook 'workbook where the data is to be pasted
    Dim wbThis           As Workbook 'workbook from where the data is to copied
    
    '******************************************
    'DEFINE COPY-FROM SOURCE WORKBOOK ..
    '******************************************
    Set wbThis = ActiveWorkbook                 'set to the current active workbook
    
    '******************************************
    'DEFINE RECEIPTS REGISTER FILE HERE..       '### ENTER YOUR FILE LOCATIONS HERE ###
    '******************************************
    zReceiptFile = "ReceiptRegister.xlsx"       '<< enter name of Receipts Register file
    zReceiptFolder = "C:\myfolder\"             '<< e.g. "E:\FY2016\accounts\invoices\"
    zFetch = zReceiptFolder & zReceiptFile      'full path and filename
    
    '******************************************
    'CHECK RECEIPTS REGISTER FILE EXISTS..
    '******************************************
    If Dir(zFetch) = "" Then                    'missing file!
    saywhat = "Cannot find Receipts Register file!"         'message box text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    saywhat = saywhat & "Expected filename:" & vbCr         'add text
    saywhat = saywhat & zReceiptFile                        'add text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    saywhat = saywhat & "Expected folder location:" & vbCr  'add text
    saywhat = saywhat & zReceiptFolder                      'add text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    btns = vbOKOnly + vbExclamation             'message box buttons
    boxtitle = "Update Receipts Register"       'message box heaading
    answer = MsgBox(saywhat, btns, boxtitle)    'display message box
    
    Exit Sub                                    'nothing else to do
    End If                                      'end of test for missing file
    '******************************************
    'GET REQUIRED DATA FOR THE UPDATE..
    '******************************************
    wbThis.Activate
    'it would be better to used named ranges assigned to the cells
    'rather than direct cell addresses; it would be more flexible
    'if structure changes were made to the Invoice sheet.
    
    zInvoiceNumber = [F3]
    zPmtReceivedDate = [F6]
    zCompanyName = [C13]
    zClientName = [C14]
    zGrandTotal = [F31]
    
    '******************************************
    'CHECK REQUIRED DATA IS OK..
    '******************************************
    'can make additional checks here
    'e.g. make sure required entries are not blank etc etc
    
    
    
    '******************************************
    'OPEN RECEIPTS REGISTER FILE FOR UPDATING
    '******************************************
    Application.DisplayAlerts = False           'ignore alert if file being used elsewhere
    Set wbTarget = Workbooks.Open(zFetch)       'open file, and assign shortcut to it
    '******************************************
    'CHECK READ-WRITE ACCESS TO RECEIPTS REGISTER
    '******************************************
    If wbTarget.ReadOnly = True Then            'this file is currently being used
    saywhat = "The Register file is being used elsewhere."  'message box text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    saywhat = saywhat & "Try again in a few minutes" & vbCr 'add text
    saywhat = saywhat & vbCr & vbCr                         'add 2 lines
    btns = vbOKOnly + vbInformation             'message box buttons
    boxtitle = "Update Receipts Register"       'message box heaading
    answer = MsgBox(saywhat, btns, boxtitle)    'display message box
    
    Exit Sub                                    'nothing else to do
    End If
    '******************************************
    'UPDATE RECEIPTS REGISTER FILE..
    '******************************************
    wbTarget.Activate
    r = Cells(Rows.Count, 1).End(xlUp).Row + 1  'next available row for update
    Cells(r, "A") = zPmtReceivedDate
    Cells(r, "B") = zInvoiceNumber
    Cells(r, "C") = zCompanyName
    Cells(r, "D") = zClientName
    Cells(r, "E") = zGrandTotal
    '******************************************
    'CLOSE UPDATED RECEIPTS REGISTER FILE..
    '******************************************
    wbTarget.Close savechanges:=True
    
    '******************************************
    'UPDATE STATUS TO SHOW DATA HAS BEEN POSTED..
    '******************************************
    wbThis.Activate
    [B10] = "Receipt Register has been updated"
    
    
    End Sub
    report back here if you need further help.

    zeddy
    Hi zeddy,
    Thanks for your help.
    I've removed a couple of sections as they're not relevant the the situation (sole trader, only ever 1 person using the file), and changed the success notification to a text box instead. It works perfectly in the receipt file, except that when I go back into the master (where the "receipt register" sheet is), nothing's been written. It seems that there's no step telling the macro to select this sheet - can you help me to work out where this should go/how to write it? Thanks.

    Code:
    Sub ReceiptRegister()
    
    Dim wbTarget         As Workbook 'workbook where the data is to be pasted
    Dim wbThis           As Workbook 'workbook from where the data is to copied
    
    'DEFINE COPY-FROM SOURCE WORKBOOK
    Set wbThis = ActiveWorkbook                 'set to the current active workbook
    
    'DEFINE RECEIPTS REGISTER FILE HERE
    zReceiptFile = "Invoice template v3.xlsm"
    zReceiptFolder = "C:\Users\Manda\Desktop\APD Desktop\Invoicing\"
    zFetch = zReceiptFolder & zReceiptFile     'full path and filename
    
    'GET REQUIRED DATA FOR THE UPDATE..
    wbThis.Activate
    
    zInvoiceNumber = [F3]
    zPmtReceivedDate = [F6]
    zCompanyName = [C13]
    zClientName = [C14]
    zGrandTotal = [F31]
    
    'OPEN RECEIPTS REGISTER FILE FOR UPDATING
    Set wbTarget = Workbooks.Open(zFetch)       'open file, and assign shortcut to it
    
    
    'UPDATE RECEIPTS REGISTER FILE
    wbTarget.Activate
    r = Cells(Rows.Count, 1).End(xlUp).Row + 1  'next available row for update
    Cells(r, "A") = zPmtReceivedDate
    Cells(r, "B") = zInvoiceNumber
    Cells(r, "C") = zCompanyName
    Cells(r, "D") = zClientName
    Cells(r, "E") = zGrandTotal
    
    'CLOSE UPDATED RECEIPTS REGISTER FILE
    wbTarget.Close savechanges:=True
    
    'UPDATE STATUS TO SHOW DATA HAS BEEN POSTED
    wbThis.Activate
    saywhat = "Receipt Register has been updated"
    btns = vbOKOnly + vbExclamation             'message box buttons
    answer = MsgBox(saywhat, btns, boxtitle)    'display message box
    
    End Sub

  4. #4
    WS Lounge VIP
    Join Date
    Mar 2002
    Location
    Newcazzle, UK
    Posts
    2,827
    Thanks
    136
    Thanked 482 Times in 459 Posts
    Hi mand

    Have a look at this code, and see if this does it:
    Code:
    Sub ReceiptRegister()
    
    Dim wbTarget         As Workbook 'workbook where the data is to be pasted
    Dim wbThis           As Workbook 'workbook from where the data is to copied
    
    'DEFINE COPY-FROM SOURCE WORKBOOK
    Set wbThis = ActiveWorkbook                 'set to the current active workbook
    
    'DEFINE RECEIPTS REGISTER FILE HERE
    zReceiptFile = "Invoice template v3.xlsm"
    zReceiptsWKsheetname = "receipts register"  '<< specify sheet tab name for update
    zReceiptFolder = "C:\Users\Manda\Desktop\APD Desktop\Invoicing\"
    zFetch = zReceiptFolder & zReceiptFile     'full path and filename
    
    'GET REQUIRED DATA FOR THE UPDATE..
    wbThis.Activate                             'switch to Invoice file
    
    zInvoiceNumber = [F3]
    zPmtReceivedDate = [F6]
    zCompanyName = [C13]
    zClientName = [C14]
    zGrandTotal = [F31]
    
    'OPEN RECEIPTS REGISTER FILE FOR UPDATING
    Set wbTarget = Workbooks.Open(zFetch)       'open file, and assign shortcut to it
    
    
    'UPDATE RECEIPTS REGISTER FILE
    wbTarget.Activate                           'switch to Register file
    Sheets("receipts register").Select          '<< specify sheet tab name for update
    r = Cells(Rows.Count, 1).End(xlUp).Row + 1  'next available row for update
    Cells(r, "A") = zPmtReceivedDate
    Cells(r, "B") = zInvoiceNumber
    Cells(r, "C") = zCompanyName
    Cells(r, "D") = zClientName
    Cells(r, "E") = zGrandTotal
    
    'SAVE AND CLOSE UPDATED RECEIPTS FILE
    wbTarget.Save
    wbTarget.Close
    
    'UPDATE STATUS TO SHOW DATA HAS BEEN POSTED
    wbThis.Activate
    saywhat = "Receipt Register has been updated"
    btns = vbOKOnly + vbExclamation             'message box buttons
    answer = MsgBox(saywhat, btns, boxtitle)    'display message box
    
    End Sub
    To update the Receipts Register file, you select an invoice file (i.e. make it the active workbook), and then run this macro.

    Note: the reason I placed a 'message' in the actual invoice file was to indicate that, if that file was subsequently selected again, you would know that it had already been 'posted' to the Register file (i.e. to help prevent 'multiple posting' of the same invoice details).

    zeddy

Posting Permissions

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