Retrieving data from 400 worksheets and exporting everything in one other worksheet

[maelr]

Hello,

I have an URGENT request.

I am experiencing an issue with retrieving data from multiple excel worksheets (about 400) located in one folder and exporting it in one other excel worksheet.

Each worksheet's structure is the same as the others except for the answers that change from one file to another. I would like to retrieve the data from these 400 worksheets (the ANSWER column for every tab) and export it to OUTPUT.xls having each set of answers in a horizontal display as shown in the output.xls file.

The 400 worksheets follow the same structure than the Example.xls sheet except for the content which changes.

What would you suggest?

Somebody gave me this VBA code but it doesn't seem to work...

Option Explicit

Sub cons_data()

Dim Master As Workbook
Dim sourceBook As Workbook
Dim lcol As Long
Dim CurrentFileName As String
Dim myPath As String

'The folder containing the files to be recap'd
myPath = "D:\Test"

'Finds the name of the first file of type .xls in the current directory
CurrentFileName = Dir(myPath & "\*.xls")

'Create a workbook for the recap report
Set Master = ThisWorkbook

Do
    Workbooks.Open (myPath & "\" & CurrentFileName)
    Set sourceBook = Workbooks(CurrentFileName)
    lcol = Master.Worksheets(1).Range("IV6").End(xlToLeft).Column
    
    With sourceBook
        Master.Worksheets(1).Cells(5, lcol + 1).Value = CurrentFileName
        .Worksheets("tab1").Range("B2:B10").Copy
        Master.Worksheets(1).Cells(6, lcol + 1).PasteSpecial (xlPasteValues)
        .Worksheets("tab2").Range("B2:B16").Copy
        Master.Worksheets(1).Cells(15, lcol + 1).PasteSpecial (xlPasteValues)
        .Worksheets("tab3").Range("B2:B6").Copy
        Master.Worksheets(1).Cells(30, lcol + 1).PasteSpecial (xlPasteValues)
        .Worksheets("tab4").Range("B2:B6").Copy
        Master.Worksheets(1).Cells(35, lcol + 1).PasteSpecial (xlPasteValues)
        .Worksheets("tab5").Range("B2:B70").Copy
        Master.Worksheets(1).Cells(40, lcol + 1).PasteSpecial (xlPasteValues)
         .Worksheets("tab6").Range("B2:B25").Copy
        Master.Worksheets(1).Cells(109, lcol + 1).PasteSpecial (xlPasteValues)
    End With
    
    sourceBook.Close
  
'Calling DIR w/o argument finds the next .xlsx file within the current directory.
CurrentFileName = Dir()
Loop While CurrentFileName <> ""

End Sub

Thanks a lot,

[arlu1201]

Which part of the code does not work?

If your header is in row1 and your data starts in row2 of the master file, then change this row from

 lcol = Master.Worksheets(1).Range("IV6").End(xlToLeft).Column

to

 lcol = Master.Worksheets(1).Range("IV1").End(xlToLeft).Column

[Mike_e]

I had a similar requirement and the fastest solution I found was to use the get external data function. The steps the macro followed were as follows:

1. Run a routine that lists all the files in a directory
2. Run through the list and, using the get external data function, import the data.
3. Copy the data from the file to wherever you want in your workbook
4. Loop the code until all files have been opened.

The time taken to run this for about 50 files was a minute or two. You will need to consider file handling etc as well.