How to create a macro to extract data from multiplefiles and save into antable

QuestionEdit

QUESTION: Good day I am new tomacros. I have approximately 60 files (with the same template form) updated every week where I need to extract information from each file for the designer's name in cell G6 and drawing # from cell A11 to A??, whatever the number of entries (varies but the last cell is A40) and % complete from cell F11 to F??, whatever the number of entries. Some times there may be more than one sheet in a file because of the overflowing number of entries. Do I need to have a common sheet name on all 60 files?

I need to extract the aforementioned data from 60 files into one newfile into a table with 1st column containing drawing #, 2nd column with % complete, 3rd column with designer's name (same for all entries within the same file). There are 60 designers, hench the 60 files.

How can I do this with a macro in Excel?

Thank you so much for your help. I need to come up with something in the next couple of days for my boss and I don't know where to start.

ANSWER: Mike,

so you have 40 rows of data per sheet per file but most files have one worksheet

and you will put that data going down the consolidation worksheet

30 rows * 60 = 2400 rows (plus extra sheets) of data, 3 columns Wide:

Assume G6 in every sheet in a workbook contains the designer's name (if two sheets, both have designer name in G6 - this assumption can be changed, but that is the way it is written now)

Put all the files in a single folder (assume they are allworkbooks and any sheet in that workbook needs to be processed

Option Explicit Sub ProcessWorkbooks() Dim Dest As Worksheet, sh As Worksheet Dim rw As Long, spath As String, sname As String Dim r As Range, bk As Workbook Set Dest = ActiveSheet rw = 2 spath = "j:\Data\Tester1\" ' must end with a back slash sname = Dir(spath & "*.xls") ' if they are xlsx, then use "*.xlsx" Do While sname <> ""

 Set bk = Workbooks.Open(spath & sname)
 For Each sh In bk.Worksheets
   Set r = sh.Range("A11", sh.Cells(41, "A").End(xlUp))
   r.Copy
   Dest.Cells(rw, "A").PasteSpecial xlValues
   r.Offset(0, 5).Copy
   Dest.Cells(rw, "B").PasteSpecial xlValues
   Dest.Cells(rw, "C").Resize(r.Rows.Count, 1) = sh.Range("G6")
   rw = rw + r.Rows.Count
 Next
 bk.Close SaveChanges:=False
 sname = Dir()

Loop Dest.Columns(2).NumberFormat = "0.0%" End Sub

That worked for me.

---------- FOLLOW-UP ----------

QUESTION: Wow, that was fast. Thank you so much Tom. It worked but with a few bugs. I don't know why I have 4 lines between each set of entries XX-XXXX-XXXX-XX-X-X DD/MM/YY Designer's name. Also, I added another data value of

  Dest.Cells(rw, "C").Resize(r.Rows.Count, 1) = sh.Range("C7")

above row 

  Dest.Cells(rw, "D").Resize(r.Rows.Count, 1) = sh.Range("G6")

but for some strange reason I don't pull the correct value in G6 for one of the files when I test it with two data files. Strange because the second set of data pulled the correct values.

Not sure if it names a difference but instead of A11, I meant B11 so I changed to

 Set r = sh.Range("B11", sh.Cells(41, "B").End(xlUp))

And actually, B11 is a merged with C11 in the data file and this seemed okay with the program.

What does Resize(r.Rows.Count, 1) do?

ANSWER: Mike,

>but for some strange reason I don't pull the correct value in G6 for one of the files

Code is pretty consistent. I would suggest you have a data error in that file and the deisgner name is not in cell G6 on the sheet with the data (recall that I said I expected the name to appear on each sheet).

Merge cells are problematic when addressing ranges and copying and pasting. You seem to indicate it isn't a problem for you.

> I don't know why I have 4 lines between each set of entries XX-XXXX-XXXX-XX-X-X DD/MM/YY Designer's name

If you go to the bottom of the worksheet or well past your data in column B and hit the end key and then the up arrow, where the selection stops is where I end the region to copy the data. If there are 4 blank rows in that range, then that is why you would have that situation. The cells may appear blank, butdoesn't consider them blank. Other than that, I would see no reason you would have 4 blank rows

Resize(r.Rows.Count, 1) it makes the the size of the range r.rows.count tall.

I hope I have answered you questions. It is not completely obvious what your question/concerns are.

---------- FOLLOW-UP ----------

QUESTION: I have another question. I have been learning a lot by going through your program. I'm trying to add another piece of information starting in cell G11 and moving down, similar to the drawing # and % complete. I added

  r.Offset(0, 1).Copy
  Dest.Cells(rw, "F").PasteSpecial xlValues

to the program

Do While sname <> ""

Set bk = Workbooks.Open(spath & sname)
For Each sh In bk.Worksheets
  Set r = sh.Range("B11", sh.Cells(41, "B").End(xlUp))
  r.Copy
  Dest.Cells(rw, "A").PasteSpecial xlValues
  r.Offset(0, 4).Copy
  Dest.Cells(rw, "B").PasteSpecial xlValues
     
  r.Offset(0, 1).Copy
  Dest.Cells(rw, "F").PasteSpecial xlValues
         
  Dest.Cells(rw, "C").Resize(r.Rows.Count, 1) = sh.Range("C7")
  Dest.Cells(rw, "D").Resize(r.Rows.Count, 1) = sh.Range("G6")
  Dest.Cells(rw, "E").Resize(r.Rows.Count, 1) = sh.Range("H7")

But it doesn't seem to be pulling the right info. This new data point is a date feature.

AnswerEdit

r.offset(0,1).copy copies data from column C (as you have revised the code).

If you want to copy data from column G it would b e

r.offset(0,5).copy Dest.Cells(rw, "F").PasteSpecial xlValues

It looks like you are copying it to column F

You might need to add a command to format column F as date

where I have Dest.Columns(2).NumberFormat = "0.0%"

you would add

Dest.Columns(2).NumberFormat = "0.0%" ' column B Dest.columns(6).Numberformat = "mm/dd/yyy" ' column F

Does that get it working?