Copying many workbooks into one workbook

Lost in Quality

New Member
Joined
Jul 28, 2009
Messages
9
Hi,

I wonder if someone can help me please?

I have many excel files(nearly 500 in total and growing daily) in a folder called "Results Data" on my C drive. The file names are slightly different (serial numbers). Each excel file contains data in Cells A2:E11. I want to be able to copy only the Cells A2, B4, D5 and E10 from each workbook and paste them into a new workbook, each copied workbook on a new row.

I have been trying to change code that I have found on the web but nothing seems to be working, its like monkey tennis with me:confused:

Thanks in advance for your time and effort.
 

Weaver

Well-known Member
Joined
Sep 10, 2008
Messages
5,196
create a new workbook and paste the following into a new module

Code:
 Sub getData()
    Application.ScreenUpdating = False
    fldr = "c:\results data\"
    Set ts = ActiveSheet
    a = Array("file", "A2", "B4", "D5", "E10")
    ts.Range("A1:E1") = a
    d = Dir(fldr & "*.xls")
    r = 2
    Do While d <> ""
        ts.Cells(r, 1) = d
        Set nw = Workbooks.Open(fldr & d)
        For c = 2 To 5
            ts.Cells(r, c) = nw.Sheets(1).Range(a(c - 1)).Value
        Next
        nw.Close
        r = r + 1
        d = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
When you run it the required data will appear in the current worksheet. 500+ files might take a while, so I'd go make a brew. you might want to run it on a smaller subset first, just in case...
 
Last edited:

Lost in Quality

New Member
Joined
Jul 28, 2009
Messages
9
Thanks very Much.

It works excatly how I imagined.:)

Took your suggestion and tried it out first on a small sample of files.

If you dont mind me asking another question of you? could you give me the name of a good book or website in order for me to try and learn and hopefully understand. I would like to have a go myself.

Thanks again

All the best
 

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
Hi
save the file with the following codes in the folder C:\resultsdata\ and run the macro. It pulls data from closed file. since you have only 4 values per file, I believe it shold be faster.
Code:
Sub List()
Dim z  As Long, e As Long, g As Long
Dim f As String, h As String
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
Do While Len(f) > 0
ActiveCell.Formula = f
ActiveCell.Offset(1, 0).Select
f = Dir()
Loop
z = Cells(Rows.Count, 1).End(xlUp).Row
For e = 3 To z
For g = 1 To 4
h = Choose(g, "A2", "B4", "D5", "E10")
Cells(2, g + 1) = h
Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Sheet1'!" & h
Cells(e, g + 1) = Cells(1, 3)
Next g
Next e
Range("A1:C1").Delete
MsgBox "collating is complete."
End Sub
Ravi
 

Weaver

Well-known Member
Joined
Sep 10, 2008
Messages
5,196
Good point, ravi. I've done this type of task this way myself before now. It's worth knowing both methods, in case you need to change the target files as well.

LOQ as for learning how, well sometimes you've just got to get stuck in. Break your problems down into bitesized chunks and use other people's posts where you can. As you can already see, there's usually more than one way to achieve your goals, which is where I think books don't really tell the full story. I learned a lot of what I know by trial and error from this site.
 

Lost in Quality

New Member
Joined
Jul 28, 2009
Messages
9
Hi Weaver,

I am not too sure what I have done but the first code worked on the small sample. But the post from you now looks a different code and all it displays on the new work book are the headings. I Accidently closed the workwork and did not save the first one I tried. School boy error I know
 

Weaver

Well-known Member
Joined
Sep 10, 2008
Messages
5,196
Ravi's was the best idea, but I've modded it

Code:
 Sub List()
    Application.ScreenUpdating = False
    Dim z  As Long, e As Long, g As Long
    Dim f As String, h As String
    p = ActiveWorkbook.Path & "\"
    r = 2
    f = Dir(p & "*.xls")
    Do While Len(f) > 0
        If f <> ActiveWorkbook.Name Then
            Cells(r, 1) = f
            r = r + 1
        End If
    f = Dir()
    Loop
    For e = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        For g = 1 To 4
        h = Choose(g, "A2", "B4", "D5", "E10")
        Cells(1, g + 1) = h
        Cells(e, g + 1) = "='" & p & "[" & Cells(e, 1) & "]Sheet1'!" & h
        Next g
    Next e
    Application.ScreenUpdating = True
    MsgBox "collating is complete."
End Sub
Save this in a new sheet in your folder and then run it.
 

Lost in Quality

New Member
Joined
Jul 28, 2009
Messages
9
Hi Ravi,

Thank you also. Yes there does seem to be more than one way to crack a nut. I am not too sure if its my set up but when I ran your code it cascaded the results, they were not all on the same row.
 

Forum statistics

Threads
1,082,253
Messages
5,364,045
Members
400,776
Latest member
JimmyLee

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top