Solved

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

Posted on 2012-03-22
10
413 Views
Last Modified: 2012-03-23
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!).

Thanks
expertopenworkbooks.xls
0
Comment
Question by:bvanscoy678
  • 6
  • 4
10 Comments
 
LVL 12

Accepted Solution

by:
kgerb earned 500 total points
ID: 37754785
Hello,
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)
        ThisWorkbook.Activate
        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

Kyle
0
 

Author Comment

by:bvanscoy678
ID: 37754843
Hello,

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")

Thanks
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37755324
"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.

Kyle
0
 

Author Closing Comment

by:bvanscoy678
ID: 37755454
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.
Brent
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37755473
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.

Kyle
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 

Author Comment

by:bvanscoy678
ID: 37755541
Thanks!
0
 

Author Comment

by:bvanscoy678
ID: 37756978
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.
0
 

Author Comment

by:bvanscoy678
ID: 37756993
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!

Thanks.
0
 
LVL 12

Expert Comment

by:kgerb
ID: 37757038
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!

Kyle
0
 

Author Comment

by:bvanscoy678
ID: 37757107
Thanks!
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

706 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

21 Experts available now in Live!

Get 1:1 Help Now