Copying many workbooks into one workbook

[Lost in Quality]

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

Thanks in advance for your time and effort.

 

[Weaver]

Do the sheets only have one tab in each?

 

[Lost in Quality]

Hi,

Thanks for looking at this so quickly.

Each of the excel files only contain one worksheet.

 

[Weaver]

create a new workbook and paste the following into a new module

 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...

 

[Lost in Quality]

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]

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.

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]

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]

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]

Ravi's was the best idea, but I've modded it

 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]

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.