[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

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

Posted on 2012-08-11
3
Medium Priority
?
856 Views
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
         Next
     Next


End Sub

Open in new window


Any help ....  would be greatly appreciated!  :)   Thank you in Advance!
MPT-EndUser.zip
MPT-Data-UPDATE.zip
0
Comment
Question by:"Abys" Wallace
  • 2
3 Comments
 
LVL 17

Accepted Solution

by:
andrewssd3 earned 2000 total points
ID: 38284108
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
        Else
            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.Save
        MasterWB.Close xlDoNotSaveChanges
        
        ' now delete all rows from the input table
        loEndUserTable.DataBodyRange.EntireRow.Delete
        
    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.
0
 

Author Closing Comment

by:"Abys" Wallace
ID: 38284444
Thank You!  works perfect!  :)
0
 

Author Comment

by:"Abys" Wallace
ID: 38284539
@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
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

830 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