file data from many file in a folers to summary file

[cds1]

I have the folders named Indiant20 contains about 100 excel files apart from other files. Each files contains various sheets also contains summary, summary1, scoresheet sheets. I want to copy data from summary sheet summary sheet of master data file and file in each row , similarly summary1 to summary1 sheet of master data file and scoresheet to scoresheet. I have the following vba which does not work properly . Kindly help me in solving problem

Sub loopAllSubFolderSelectStartDirectorn()


Call LoopAllSubFolders1("d:\indian t20")

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Sub LoopAllSubFolders1(ByVal folderPath As String)
Dim wb As Workbook, fileName As String, fullFilePath As String, numFolders As Long, folders() As String, i As Long, wkbDest As Workbook, lrow As Long, wsSummary As Worksheet
Dim LastRowWs As Long, LastRowSummary As Long


Set wkbDest = Workbooks.Open("D:\cricket summary11.xlsm")
Application.Calculation = xlCalculationManual
With Application
.EnableEvents = False
.DisplayAlerts = False
.ScreenUpdating = False
.Visible = False
End With
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
fileName = Dir(folderPath & "*.*", vbDirectory)

While Len(fileName) <> 0

If Left(fileName, 1) <> "." And Right(fileName, 4) <> ".xls" Then

fullFilePath = folderPath & fileName

If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
ReDim Preserve folders(0 To numFolders) As String
folders(numFolders) = fullFilePath: numFolders = numFolders + 1
Else


Set wb = Workbooks.Open(folderPath & fileName)
fileName = Mid(fileName, 1, Len(fileName) - 5) & ".xls"


LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1
wsSummary.Range("A2:m" & LastRowSummary).Clear
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Summary" Then
LastRowWs = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
StartRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row + 1 'first empty row
ws.Range("A2:m" & LastRowWs).Copy Destination:=wsSummary.Range("A" & StartRowSummary)
LastRowSummary = wsSummary.Cells(wsSummary.Rows.Count, "A").End(xlUp).Row
wsSummary.Range("S" & StartRowSummary & ":S" & LastRowSummary) = ws.Name
End If

Next
End If
End If
Wend
Application.ScreenUpdating = True
End Sub


Thanks in advance

[Pepe Le Mokko]

Administrative Note:

Welcome to the forum.

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between [CODE]Please [url=https://www.excelforum.com/login.php]Login or Register [/url] to view this content.[/CODE] tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

[Pepe Le Mokko]

As you have never followed up on your previous threads, perhaps tell us on what other forum you posted the same question?