Subdirectory traverse and append to single file

"Do you want this to run against all workbooks found in those directories?:
Yes
o/p would be
Id     Name     Age     CName
1    ABC    12    CompanyName
2    XYZ    43    CompanyName
3    YUI     41    CompanyName

OK, then try this:

Sub ListSubFiles(strParentFolder As String)
    Dim fs As FileSearch
    Dim lngCounter As Long, lngRow As Long, lngOutputRow As Long
    Dim wbk As Workbook, wks1 As Worksheet, wks2 As Worksheet, wksSummary As Worksheet
    Dim rngData As Range, rngCell As Range
    Dim strCompany As String
    Application.ScreenUpdating = False
    Set wksSummary = ActiveWorkbook.ActiveSheet
    lngOutputRow = 1
    Set fs = Application.FileSearch
    With fs
        .NewSearch
        .LookIn = strParentFolder
        .SearchSubFolders = True
        .FileName = "*.xls"
        .MatchTextExactly = True
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        ' Loop through all the found files
        For lngCounter = 1 To .FoundFiles.Count
            Set wbk = Workbooks.Open(.FoundFiles(lngCounter))
            Set wks1 = wbk.Sheets("Detail sheet")
            Set wks2 = wbk.Sheets("Summary sheet")
            strCompany = wks2.Range("C3")
            ' Assumes there will always be data in column 1
            Set rngData = Intersect(wks1.UsedRange, wks1.Columns(1))
            For Each rngCell In rngData
                ' Write columns 1, 2 and 4 and company name to sheet 1 of this workbook
                wksSummary.Cells(lngOutputRow, 1) = rngCell
                wksSummary.Cells(lngOutputRow, 2) = rngCell.Offset(0, 1)
                wksSummary.Cells(lngOutputRow, 3) = rngCell.Offset(0, 3)
                wksSummary.Cells(lngOutputRow, 4) = strCompany
                lngOutputRow = lngOutputRow + 1
                Exit For
            Next rngCell
            wbk.Close False
        Next lngCounter
        Set rngData = Nothing
        Set wks1 = Nothing
        Set wks2 = Nothing
        Set wbk = Nothing
    End With
    Set fs = Nothing
    Application.ScreenUpdating = True
End Sub


called by ListSubFiles ParentFolderNameAndPath


HTH
Rory

and from where do i call this function ?
I created a macro in an excel sheet and ran it from there, but it gives an problem.

You would copy it into a module in either a new workbook or in your Personal.xls file lif you have one. Then run it with a macro that looks like:
Sub DoList()
    ListSubFiles "C:\Parent Folder"
End Sub.

I have just noticed a mistake in the code though - it should be:
Sub ListSubFiles(strParentFolder As String)
    Dim fs As FileSearch
    Dim lngCounter As Long, lngRow As Long, lngOutputRow As Long
    Dim wbk As Workbook, wks1 As Worksheet, wks2 As Worksheet, wksSummary As Worksheet
    Dim rngData As Range, rngCell As Range
    Dim strCompany As String
    Application.ScreenUpdating = False
    Set wksSummary = ActiveWorkbook.ActiveSheet
    lngOutputRow = 1
    Set fs = Application.FileSearch
    With fs
        .NewSearch
        .LookIn = strParentFolder
        .SearchSubFolders = True
        .FileName = "*.xls"
        .MatchTextExactly = True
        .FileType = msoFileTypeExcelWorkbooks
        .Execute
        ' Loop through all the found files
        For lngCounter = 1 To .FoundFiles.Count
            Set wbk = Workbooks.Open(.FoundFiles(lngCounter))
            Set wks1 = wbk.Sheets("Detail sheet")
            Set wks2 = wbk.Sheets("Summary sheet")
            strCompany = wks2.Range("C3")
            ' Assumes there will always be data in column 1
            Set rngData = Intersect(wks1.UsedRange, wks1.Columns(1))
            For Each rngCell In rngData
                ' Write columns 1, 2 and 4 and company name to sheet 1 of this workbook
                wksSummary.Cells(lngOutputRow, 1) = rngCell
                wksSummary.Cells(lngOutputRow, 2) = rngCell.Offset(0, 1)
                wksSummary.Cells(lngOutputRow, 3) = rngCell.Offset(0, 3)
                wksSummary.Cells(lngOutputRow, 4) = strCompany
                lngOutputRow = lngOutputRow + 1
            Next rngCell
            wbk.Close False
        Next lngCounter
        Set rngData = Nothing
        Set wks1 = Nothing
        Set wks2 = Nothing
        Set wbk = Nothing
    End With
    Set fs = Nothing
    Application.ScreenUpdating = True
End Sub


If that produces an error, can you tell me what the error is?

Regards,
Rory

guess ur above code removed that error, but i dont want the headers to be repeated each time.
the header should come only once.  and the info of CELL C row 3 gets written into the header also
now the o/p comes like
Id           Name             Age         The Companyname
1          ABC                   12    CompanyName
Id           Name             Age         The Companyname2
2           VCX             54          The Companyname2

while i want the o/p to be like

Id     Name     Age     CName
1    ABC    12    CompanyName
2    XYZ    43    CompanyName
3    YUI     41    CompanyName
4    CV       12   SecondCompany
5    AE        56  SecondCompany
6   RD         53  SecondCompany
7   XC         56 SecondCompany

thanks for your time.Excellent work.