Copy Data from one Workbook to another Workbook that has a table Until Blank row

Posted on 2012-08-11
Last Modified: 2012-08-11
Hi everyone ...

I'm working a project where I'm creating a userform for a data entry environment where the end user submits data into a worksheet within their workbook.  Once they're done they'll have an update button that I would like to COPY data from their workbook's worksheet to a Master Workbook's worksheet that has a table.

After all the data is copied from the end users workbook I would like the VBA to close and save the Master workbook and then delete the data from the end user's workbook.

I've researched high and low and found pieces of code that I placed together to seem to get the concept but when I hit UPDATE it just copies cell (A3) data until it reaches the end of the Master workbook's worksheet...  

Private Sub cmdUpdate_Click()
    Dim ThisWorkbook As Workbook
    Dim MasterWB As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim lRow As Long
    Dim NextRow As Long
    Dim Group As Range, Mat As Range
    Dim CurCell_1 As Range, CurCell_2 As Range
    Application.ScreenUpdating = False
    Set MasterWB = Application.Workbooks.Open("H:\Projects\Master Process Tracker for Rayanne\test\MPT_Data_UPDATE.xlsx")
    Set ThisWorkbook = Application.Workbooks("MPT_EndUser.xlsm")
    Set ws1 = ThisWorkbook.Sheets("MAR")
    Set ws2 = MasterWB.Sheets("MAR")
NextRow = WorksheetFunction.CountA(MasterWB.Worksheets("MAR").Range("A:A")) + 1
MasterWB.Worksheets("MAR").Cells(NextRow, 1).Value = ThisWorkbook.Worksheets("MAR").Range("a3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 2).Value = ThisWorkbook.Worksheets("MAR").Range("b3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 3).Value = ThisWorkbook.Worksheets("MAR").Range("c3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 4).Value = ThisWorkbook.Worksheets("MAR").Range("d3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 5).Value = ThisWorkbook.Worksheets("MAR").Range("e3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 6).Value = ThisWorkbook.Worksheets("MAR").Range("f3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 7).Value = ThisWorkbook.Worksheets("MAR").Range("g3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 8).Value = ThisWorkbook.Worksheets("MAR").Range("h3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 9).Value = ThisWorkbook.Worksheets("MAR").Range("i3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 10).Value = ThisWorkbook.Worksheets("MAR").Range("j3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 11).Value = ThisWorkbook.Worksheets("MAR").Range("k3").Value
MasterWB.Worksheets("MAR").Cells(NextRow, 12).Value = ThisWorkbook.Worksheets("MAR").Range("l3").Value

'~~> Loop until blank cell found in users workbook

'<~~ Change as required
For Each Group In ws1.Range("A3:L3")
         '~~> Why this?
         Set CurCell_2 = ws2.Range("a3:l3")
         For Each Mat In ws1.Range("A3:l3")
             Set CurCell_1 = ws1.Cells(3, 1)
             If Not IsEmpty(CurCell_1) Then
                 CurCell_2.Value = CurCell_1.Value
                 Set CurCell_2 = CurCell_2.Offset(1)
             End If

End Sub

Open in new window

Any help ....  would be greatly appreciated!  :)   Thank you in Advance!
Question by:"Abys" Wallace
    LVL 17

    Accepted Solution

    Give this a try:
    Option Explicit
    Private Sub cmdUpdate_Click()
        Dim MasterWB As Workbook
        Dim ws1 As Worksheet
        Dim ws2 As Worksheet
        Dim loEndUserTable As ListObject
        Dim loMasterTable As ListObject
        Dim rngIn As Range
        Dim rngOut As Range
        Application.ScreenUpdating = False
        'Set ThisWorkbook = Application.Workbooks("MPT_EndUser.xlsx")
        Set ws1 = ThisWorkbook.Sheets("MAR")
        Set loEndUserTable = ws1.ListObjects("MARTracker")
        Set rngIn = loEndUserTable.DataBodyRange
        ' only do it if there are rows in the table
        If Not rngIn Is Nothing Then
            Set MasterWB = Application.Workbooks.Open("H:\Projects\Master Process Tracker for Rayanne\test\MPT_Data_UPDATE.xlsx")
            Set ws2 = MasterWB.Sheets("MAR")
            Set loMasterTable = ws2.ListObjects("MARTracker")
            If loMasterTable.DataBodyRange Is Nothing Then
                ' if no rows yet added to master use the header range
                Set rngOut = loMasterTable.HeaderRowRange
                Set rngOut = loMasterTable.DataBodyRange
            End If
            ' move the range down to the first empty row in the master table,
            ' and resize it to be the same as the input range
            Set rngOut = rngOut.Offset(rngOut.Rows.Count, 0). _
                Resize(rngIn.Rows.Count, rngIn.Columns.Count)
            rngIn.Copy Destination:=rngOut
            MasterWB.Close xlDoNotSaveChanges
            ' now delete all rows from the input table
        End If
        Application.ScreenUpdating = True
    End Sub

    Open in new window

    This does not copy cell by cell as you ask, but gets the whole body of the end user table and copies it once to the master.  It uses the properties of the tables in both workbooks to establish where to put things.  It does assume that both the tables are identical.

    Author Closing Comment

    by:"Abys" Wallace
    Thank You!  works perfect!  :)

    Author Comment

    by:"Abys" Wallace
    @andrewssd3 is it possible to use this with more than 1 sheet... I have 3 others: PMG, EMT, AAR ... that'll go to the same size table in the Master:  PMG, EMT, AAR...  the trackers are:  EMTTracker, PMGTracker, AARTracker

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Join & Write a Comment

    New Windows 7 Installations take days for Windows-Updates to show up and install. This can easily be fixed. I have finally decided to write an article because this seems to get asked several times a day lately. This Article and the Links apply to…
    Today, still in the boom of Apple, PC's and products, nearly 50% of the computer users use Windows as graphical operating systems. If you are among those users who love windows, but are grappling to keep the system's hard drive optimized, then you s…
    This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.
    This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

    734 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    19 Experts available now in Live!

    Get 1:1 Help Now