Using VBA module in MSAccess to copy & combine multiple worksheets from a MSExcel spreadsheet to a new document

Hi Experts

Is it possible to use a VBA module in MSAccess to select certain worksheets in a MSExcel workbook (AssetMaster.xlsb) and copy, combine and save them into a new workbook (AssetMasterAll.xlsb) file as a single worksheet?

Specifically, this is what I would like the module to do...

1. Data to be pasted as values only, stripping any formula or formatting.
2. Tabs to be copied from the AssetMaster.xlsb document include, e.g. Sheet1, Sheet2, Sheet3, Sheet4.
3. Data on each worksheet starts with the same header row (B4:R4). The header row from the first sheet (Sheet1) only needs to be copied to the new document and just the data below this for any of the other worksheets (B5 onwards).
4. Copy data only to the last non-blank row in each sheet (this can vary).
5. The new document, AssetMasterAll.xlsb will have a different file path than the AssetMaster document, e.g. C:\Assets\AssetMaster.xlsb, C:\Reporting\AssetMasterAll.xlsb.
6. Each time the VBA code is run, it will automatically copy and replace the AssetMasterAll.xlsb document (without prompting).

I’ve had no luck in finding code that comes close to what I need and would really appreciate any help with a solution for this.

Thanks in advance.
darls15
darls15Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aikimarkCommented:
please post a sample version of the workbook
0
darls15Author Commented:
Hi aikimark

Thanks for getting back to me. I've attached an example of the spreadsheet (with dummy data) which the data is to be copied from (AssetMaster) as well as an example of how the final document should look (AssetMasterAll).

Please let me know if you need any further explanation.

Basically, what I am trying to do is to automatically recreate the AssetMasterAll document each day (from AssetMaster). Then, with code that I already have, delete all the data from an existing AssetMasterAll table in my database, and re-import the AssetMasterAll spreadsheet after it has been updated. I hope this makes sense.

Thanks
darls15
AssetMaster.xlsb
AssetMasterAll.xlsb
0
aikimarkCommented:
stripping any formula or formatting.
It seems that the results/output workbook you posted has both formats and formulas.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

aikimarkCommented:
Please test this
Sub Q_28709877()
    Dim wksTgt As Worksheet
    Dim wksSrc As Worksheet
    Dim rngTgt As Range
    Dim rngSrc As Range
    Dim vSheetname
    
    Set wksTgt = Workbooks("AssetMasterAll.xlsb").Worksheets("Sheet1")
    wksTgt.Range("a1").CurrentRegion.ClearContents
    wksTgt.Range("A:Q").Delete
    Set rngTgt = wksTgt.UsedRange
    Application.ScreenUpdating = False
    'Copy data values
    Set wksSrc = Workbooks("AssetMaster.xlsb").Worksheets("Sheet1")
    Set rngSrc = wksSrc.Range("B4").CurrentRegion
    wksTgt.Range(rngTgt, rngTgt.Offset(rngSrc.Rows.Count - 1, rngSrc.Columns.Count - 1)).Value = rngSrc.Value
    Set rngTgt = rngTgt.End(xlDown).Offset(1)
    For Each vSheetname In Array("Sheet2", "Sheet3", "Sheet4")
        Set wksSrc = Workbooks("AssetMaster.xlsb").Worksheets(vSheetname)
        Set rngSrc = wksSrc.Range(wksSrc.Range("B5"), wksSrc.Cells.SpecialCells(xlCellTypeLastCell))
        wksTgt.Range(rngTgt, rngTgt.Offset(rngSrc.Rows.Count - 1, rngSrc.Columns.Count - 1)).Value = rngSrc.Value
        Set rngTgt = rngTgt.End(xlDown).Offset(1)
    Next
    'resize columns
    wksTgt.Range("A:Q").Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Open in new window

0
aikimarkCommented:
Here is a more streamlined version:
Sub Q_28709877()
    Dim wksTgt As Worksheet
    Dim wksSrc As Worksheet
    Dim rngTgt As Range
    Dim rngSrc As Range
    Dim vSheetname
    
    Set wksTgt = Workbooks("AssetMasterAll.xlsb").Worksheets("Sheet1")
    wksTgt.Range("a1").CurrentRegion.ClearContents
    wksTgt.Range("A:Q").Delete
    Set rngTgt = wksTgt.UsedRange
    Set rngTgt = rngTgt.Offset(1)       'A2
    Application.ScreenUpdating = False
    'Copy data values
    For Each vSheetname In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
        Set wksSrc = Workbooks("AssetMaster.xlsb").Worksheets(vSheetname)
        Set rngSrc = wksSrc.Range(wksSrc.Range("B5"), wksSrc.Cells.SpecialCells(xlCellTypeLastCell))
        wksTgt.Range(rngTgt, rngTgt.Offset(rngSrc.Rows.Count - 1, rngSrc.Columns.Count - 1)).Value = rngSrc.Value
        Set rngTgt = rngTgt.End(xlDown).Offset(1)
    Next
    'Header row
    wksTgt.Range(wksTgt.Range("A1"), wksTgt.Range("Q1")).Value = wksSrc.Range(wksSrc.Range("B4"), wksSrc.Range("B4").End(xlToRight)).Value
    'resize columns
    wksTgt.Range("A:Q").Columns.AutoFit
    Application.ScreenUpdating = True
End Sub

Open in new window

0
darls15Author Commented:
Hi aikimark

Thank you and my apologies but I'm not fluent with code, I'm just learning as I go.

I'm getting a compile error "User-defined type not defined" on "Dim wksTgt As Worksheet". Do I need to add something else in the code to get it to run?

Also, are these the correct places where I need to indicate the location of the file?

Set wksTgt = Workbooks("C:\Reporting\AssetMasterAll.xlsb").Worksheets("Sheet1")

Set wksSrc = Workbooks("C:\Assets\AssetMaster.xlsb").Worksheets(vSheetname)

Thanks
darls15
0
aikimarkCommented:
Ah.  I forgot you are in Access.  I wrote this in Excel.
Sub Q_28709877()
    Dim oXL As Object
    Dim wkbSrc As Object
    Dim wkbTgt As Object
    Dim wksTgt As Object    'Worksheet
    Dim wksSrc As Object    'Worksheet
    Dim rngTgt As Object    'Range
    Dim rngSrc As Object    'Range
    Dim vSheetname
    Const xlCellTypeLastCell = 11
    Set oXL = CreateObject("Excel.Application")
    oXL.Visible = False
    Set wkbSrc = oXL.Workbooks.Open("C:\Assets\AssetMaster.xlsb")
    Set wkbTgt = oXL.Workbooks.Open("C:\Reporting\AssetMasterAll.xlsb")
    Set wksTgt = wkbTgt.Worksheets("Sheet1")
    wksTgt.Range("a1").CurrentRegion.ClearContents
    wksTgt.Range("A:Q").Delete
    Set rngTgt = wksTgt.UsedRange
    Set rngTgt = rngTgt.Offset(1)       'A2
    oXL.ScreenUpdating = False
    'Copy data values
    For Each vSheetname In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
        Set wksSrc = wkbSrc.Worksheets(vSheetname)
        Set rngSrc = wksSrc.Range(wksSrc.Range("B5"), wksSrc.Cells.SpecialCells(xlCellTypeLastCell))
        wksTgt.Range(rngTgt, rngTgt.Offset(rngSrc.Rows.Count - 1, rngSrc.Columns.Count - 1)).Value = rngSrc.Value
        Set rngTgt = rngTgt.End(xlDown).Offset(1)
    Next
    'Header row
    wksTgt.Range(wksTgt.Range("A1"), wksTgt.Range("Q1")).Value = wksSrc.Range(wksSrc.Range("B4"), wksSrc.Range("B4").End(xlToRight)).Value
    'resize columns
    wksTgt.Range("A:Q").Columns.AutoFit
    oXL.ScreenUpdating = True
    wkbSrc.Close False
    Set wkbSrc = Nothing
    Set wkbTgt = Nothing
    oXL.Visible = True
    Set oXL = Nothing
End Sub

Open in new window

0
darls15Author Commented:
Hi aikimark

When running the code I get a run-time error '1004', Application-defined or object-defined error. The code stops at line ... Set rngTgt = rngTgt.End(xlDown).Offset(1).

Also, my original “AssetMaster.xlsb” has the read-only option enabled. The message is … The author would like you to open 'AssetMaster.xlsb' as read-only unless you need to make changes. Open as read-only? The user options presented are Yes, No and Cancel. Is there an easy way to have “Yes” accepted automatically within this code so that just a read-only copy is opened?

Thanks again
darls15
0
aikimarkCommented:
Read-only is one of the optional open method parameters.

The error indicates that the End(xlDown) method is positioned to the last row in the workbook.  The subsequent Offset(1) is trying to drop one row lower.  I did my testing with the workbooks you posted.  It is possible that your data is such that this error might occur.  For instance, if one of your source worksheets had no data rows below the header row, that would cause such an error when the next worksheet was processed.
0
darls15Author Commented:
Thank you, I'll go back and check this and get back to you :)
0
darls15Author Commented:
Hi aikimark

Sorry for the delay in getting back to you. I did a couple of tests, first ensuring the spreadsheet I am using is in the correct format and then again with the example I originally sent you and I'm still getting the same error  in both. I have no idea what could be wrong ... do you have any other suggestions?

Thanks
darls15
0
aikimarkCommented:
Please try this version
Sub Q_28709877()
    Dim oXL As Object
    Dim wkbSrc As Object
    Dim wkbTgt As Object
    Dim wksTgt As Object    'Worksheet
    Dim wksSrc As Object    'Worksheet
    Dim rngTgt As Object    'Range
    Dim rngSrc As Object    'Range
    Dim vSheetname
    Const xlCellTypeLastCell = 11
    Set oXL = CreateObject("Excel.Application")
    oXL.Visible = False
    Set wkbSrc = oXL.Workbooks.Open("C:\Assets\AssetMaster.xlsb")
    Set wkbTgt = oXL.Workbooks.Open("C:\Reporting\AssetMasterAll.xlsb")
    Set wksTgt = wkbTgt.Worksheets("Sheet1")
    wksTgt.Range("a1").CurrentRegion.ClearContents
    wksTgt.Range("A:Q").Delete
    Set rngTgt = wksTgt.UsedRange
    Set rngTgt = rngTgt.Offset(1)       'A2
    oXL.ScreenUpdating = False
    'Copy data values
    For Each vSheetname In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
        Set wksSrc = wkbSrc.Worksheets(vSheetname)
        Set rngSrc = wksSrc.Range(wksSrc.Range("B5"), wksSrc.Cells.SpecialCells(xlCellTypeLastCell))
        wksTgt.Range(rngTgt, rngTgt.Offset(rngSrc.Rows.Count - 1, rngSrc.Columns.Count - 1)).Value = rngSrc.Value
        Set rngTgt = rngTgt.End(xlDown).Offset(1)
        If rngTgt.Row = wksTgt.Rows.Count Then
            Set rngTgt = rngTgt.End(xlUp).Offset(1)
        End If
    Next
    'Header row
    wksTgt.Range(wksTgt.Range("A1"), wksTgt.Range("Q1")).Value = wksSrc.Range(wksSrc.Range("B4"), wksSrc.Range("B4").End(xlToRight)).Value
    'resize columns
    wksTgt.Range("A:Q").Columns.AutoFit
    oXL.ScreenUpdating = True
    wkbSrc.Close False
    Set wkbSrc = Nothing
    Set wkbTgt = Nothing
    oXL.Visible = True
    Set oXL = Nothing
End Sub

Open in new window

0
darls15Author Commented:
Hi, tested this and am still getting the same error in the same place ... Set rngTgt = rngTgt.End(xlDown).Offset(1)
darls15
0
aikimarkCommented:
Oops.  Please try this
Sub Q_28709877()
    Dim oXL As Object
    Dim wkbSrc As Object
    Dim wkbTgt As Object
    Dim wksTgt As Object    'Worksheet
    Dim wksSrc As Object    'Worksheet
    Dim rngTgt As Object    'Range
    Dim rngSrc As Object    'Range
    Dim vSheetname
    Const xlCellTypeLastCell = 11
    Set oXL = CreateObject("Excel.Application")
    oXL.Visible = False
    Set wkbSrc = oXL.Workbooks.Open("C:\Assets\AssetMaster.xlsb")
    Set wkbTgt = oXL.Workbooks.Open("C:\Reporting\AssetMasterAll.xlsb")
    Set wksTgt = wkbTgt.Worksheets("Sheet1")
    wksTgt.Range("a1").CurrentRegion.ClearContents
    wksTgt.Range("A:Q").Delete
    Set rngTgt = wksTgt.UsedRange
    Set rngTgt = rngTgt.Offset(1)       'A2
    oXL.ScreenUpdating = False
    'Copy data values
    For Each vSheetname In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
        Set wksSrc = wkbSrc.Worksheets(vSheetname)
        Set rngSrc = wksSrc.Range(wksSrc.Range("B5"), wksSrc.Cells.SpecialCells(xlCellTypeLastCell))
        wksTgt.Range(rngTgt, rngTgt.Offset(rngSrc.Rows.Count - 1, rngSrc.Columns.Count - 1)).Value = rngSrc.Value
        Set rngTgt = rngTgt.End(xlDown)
        If rngTgt.Row = wksTgt.Rows.Count Then
            Set rngTgt = rngTgt.End(xlUp).Offset(1)
        Else
            Set rngTgt = rngTgt.Offset(1)
        End If
    Next
    'Header row
    wksTgt.Range(wksTgt.Range("A1"), wksTgt.Range("Q1")).Value = wksSrc.Range(wksSrc.Range("B4"), wksSrc.Range("B4").End(xlToRight)).Value
    'resize columns
    wksTgt.Range("A:Q").Columns.AutoFit
    oXL.ScreenUpdating = True
    wkbSrc.Close False
    Set wkbSrc = Nothing
    Set wkbTgt = Nothing
    oXL.Visible = True
    Set oXL = Nothing
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
darls15Author Commented:
Hi aikimark, sorry but still same problem using examples attached to ID: 40955649. I am using Excel 2013, could this be a problem?
Thanks
darls15
0
aikimarkCommented:
Please do the following.
1. Open the AssetMaster.xlsb workbook
2. Select each of the worksheets
3. On each sheet, select the top left data cell in each sheet
4. Press Ctrl+End
5. Note the cell address of the active cell

Repeat steps 3-5 for each worksheet.
0
darls15Author Commented:
Ok, did that...

Sheet 1 - R26
Sheet 2 - R32
Sheet 3 - R47
Sheet 4 - R127
0
aikimarkCommented:
Are those cells empty?
Is there data to the left of those cells?
0
darls15Author Commented:
Yes, the last cell to be selected (R?) on all spreadsheets contains no data and yes, there's data to the left. Is this where the problem lies?

My apologies aikimark, but I'm just not understanding how the code is selecting the data range as when I manually do a ctrl+shift down and right my table selects as I need it to.

Thanks again
darls15
0
aikimarkCommented:
I'm using the specialcells reference to the last cell.  If you use a cell it is included in the calculation for the last cell even if you clear the contents of that cell.  The sample workbook you posted did not have that problem.  This could be a problem for the code.  When it moves the target range, it needs a reliable way to set it to the next blank cell in the left most data column.  If empty cells are copied, this might throw off the movement.

Please post the source workbook you are using that is causing the error.
0
darls15Author Commented:
This problem happens when tested on both the example workbook and the source workbook I will be using. Unfortunately, I am unable to post the source workbook for you as it contains confidential information. The source range rarely changes, so is there a way to specify just an identified range instead? For example B4:R5000. I would be happy to just adjust the code when needed.
Thanks
darls15
0
aikimarkCommented:
The actual content of the cells doesn't matter as long as the data is a representative sample that tests the code
0
darls15Author Commented:
Thanks for your help and patience in helping me with this question. I will do a thorough check in my master source document for the problem. As this is clearly working from your end, I will close this question and accept ID: 40965352 as the solution if you have no objections.
darls15
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.