copy specific cells from multiple workbooks and worksheet and merge into one workbook

I am just starting to learn VBA and thought this would be a little easier, but not making much progress. I am using Bill Jelen's 2003 VBA book as a guide.

I have multiple workbooks in the same folder. In each workbook there are several worksheets. I want to be able to open all workbooks and each worksheet, copy the same cells each time into a new workbook, thus creating one workbook with all the information from all the workbooks.

In my example excel file, I have created two worksheets. The first worksheet named OriginalWorksheet! contains the data I want to copy and then paste into the new workbook. This worksheet is the same in multiple worksheet per workbook.

Then, copy and paste special to a merged workbook (example is the worksheet NewMergeWorkbook!).

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.

kgerbChief EngineerCommented:
Try this routine.  It's working for me.  Make sure it's doing what you want.  If not let me know and we can adjust.  Make sure to modify the folder path as necessary.
Sub MergeData()
Dim FSO As Object, fld As Object, FileItem As Object, sPath As String, sExt As String
Dim wb As Workbook, ws As Worksheet, wsTo As Worksheet
sExt = "XLS, XLSX, XLSM"
sPath = "C:\Youre folder path goes here" 'Make sure to modify folder path
Set FSO = CreateObject("Scripting.FileSystemObject")
Set fld = FSO.GetFolder(sPath)
Set wsTo = ThisWorkbook.Sheets("New Merged Workbook")

For Each FileItem In fld.Files
    If InStr(1, sExt, UCase(Mid(FileItem.Name, InStrRev(FileItem.Name, ".", -1) + 1))) > 0 Then
        Set wb = Workbooks.Open(FileItem)
        For Each sht In wb.Sheets
            r = wsTo.Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsTo.Cells(r, 1) = sht.Range("C1")
            wsTo.Cells(r, 2) = sht.Range("B3")
            wsTo.Cells(r, 3) = sht.Range("C3")
            wsTo.Cells(r, 4) = sht.Range("D3")
        Next sht
        wb.Close False
    End If
Next FileItem
End Sub

Open in new window


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
bvanscoy678Author Commented:

I created a new workbook. Inserted a module. Named my pathway. Ran the macro.

I get an error on (I think this is a variable)

Set wsTo = ThisWorkbook.Sheets("New Merged Workbook")

kgerbChief EngineerCommented:
"New Merged Workbook" was the name of the worksheet in the example file so that's what I used.  Either change the name of the worksheet to "New Merged Workbook" or edit the code to match the name of the worksheet into which you want the values written.

Amazon Web Services

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

bvanscoy678Author Commented:
Yes, that did the trick. It runs now with no errors. I am going to study it more tomorrow, so I understand how the string works with the IF statement.

Thank you for your time.
kgerbChief EngineerCommented:
You're welcome.  Glad to help.

The IF statement is no big deal.  It is just making sure it only tries to open Excel files (files with extensions xls, xlsx, or xlsm).  The mid function pulls the extension out of the name of the file being examined.  If file name extension is present in the string sExt then it satisfies the condition and proceeds with the code inside the IF statement.  Let me know if you have further questions on how it works.

bvanscoy678Author Commented:
bvanscoy678Author Commented:
Good Morning,

I read through and studied the code this morning and I have a couple of questions if you have a minute. The code works perfect, but it get a bug after it completes the For Each Loop. I think I am doing something wrong. I stepped through the code and this is what I did and what I observed.

1. I created a new workbook in the same folder as all of my other workbooks I am merging. I called the workbook the same name as my worksheet: "New Merged Workbook". I placed your code into that workbook and ran the code.
2. I see it goes into the For Each Loop, then ALL of my data is copied into the new workbook with the If Statement. Once all of the data is copied over, it Ends and goes to the Next FileItem, then I get a dialogue box that tells me "New Merged workbook is already open. Reopening will cause changes you made will be disguarded".  If I choose no, it then bugs out with the IF statement (Set wb = Workbooks.Open(FileItem).

I have the data I need and can simply stop, but I am trying to learn, so I would greatly appreciate a little extra help in understanding the code.

I thought the For Each FileItem in fld.Files would be referring to each workbook and then the if statement would gather the data from each worksheet in that workbook. Then it would loop with the next FileItem to get the data from the next workbook until all workbooks were opened and copied.

Thanks for the extra help.
bvanscoy678Author Commented:
Okay, I am an idiot! I am going to leave my original post as a reminder to myself not to overlook the obvious!

Since, I created the new workbook in the same folder as what the loop, it caused the error!
I moved my new workbook into a separate folder and it worked perfect!

Thanks for the help. Working through the code was a great way to learn!

kgerbChief EngineerCommented:
Don't worry about it.  We've all been there.  Learning is messy stuff:).  Good for you for taking the time to understand and not just getting results and moving on.

Your understanding of the code is correct.  The For Each..Next loop goes through every file in the specified folder.  The IF statement checks to see if the file is an excel file.  Without this check the code would throw an error when it asked Excel to open a non-native file.  If you are sure you will never have anything but Excel files in your folder you can remove the IF statement.

If the IF statement is satisfied it continues on and runs the code inside the IF block.  Everything else is pretty straightforward, just setting one cell equal to another.  The only "tricky" part was using the End method to find the last row containing data (line 15).  This line is equivalent to selecting the very last cell in column A, holding Ctrl, and pressing the up arrow.  You are taken to the next cell containing data which happens to be the last populated row in the spreadsheet.  Just something to keep in your toolbox for the next time you need it.

Good luck, keep learning, I have found my knowledge of VBA to be incredibly useful and fulfilling.  Stick with it!

bvanscoy678Author Commented:
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 Excel

From novice to tech pro — start learning today.