Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

add all the files under the same folder including the subfolder, all sheets in worbook included

Status
Not open for further replies.

kapok1

Technical User
Apr 20, 2023
6
0
0
CN
I have another question, the following is the vba code, but could not find the files under the sub-folder, the code could only find and copy the specific datas from "cost"(sheet name) in the excel workbook files under the same folder, but could not copy the data from the files under the sub-folder in this folder.
and what's more, it could only copy all the data from the sheetname is "cost", if i wannna copy all the sheets(with same structure) from every workbook under the same folder including sub-folder, how to amend the code. thanks for your help.
file = Dir(folderPath & "\*.xls*")
Do While file <> ""

If Not file = ThisWorkbook.Name Then
Set wb = Workbooks.Open(folderPath & "\" & file)
With wb.Sheets("cost")
Set costRange = .Range("A4:D15")
Set dataRange = .Range("G4:I15")
lastRow = ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row + 1
erow = 0 '

For Each Row In costRange.Rows
If Not IsEmpty(Row.Cells(1, 1)) Then

ThisWorkbook.Sheets(1).Cells(lastRow, 15) = wb.Name
ThisWorkbook.Sheets(1).Cells(lastRow, 2) = Row.Cells(1, 1)
'ThisWorkbook.Sheets(1).Cells(lastRow, 2).Resize(, 3) = Row.Value
ThisWorkbook.Sheets(1).Cells(lastRow, 11) = Row.Cells(1, 3)
ThisWorkbook.Sheets(1).Cells(lastRow, 12) = Row.Cells(1, 4)
lastRow = lastRow + 1

End If
Next
For Each Row In dataRange.Rows
If Not IsEmpty(Row.Cells(1, 1)) Then

ThisWorkbook.Sheets(1).Cells(lastRow, 15) = wb.Name
ThisWorkbook.Sheets(1).Cells(lastRow, 2).Value = Row.Cells(1, 1)
ThisWorkbook.Sheets(1).Cells(lastRow, 11) = Row.Cells(1, 2)
ThisWorkbook.Sheets(1).Cells(lastRow, 12) = Row.Cells(1, 3)
lastRow = lastRow + 1

End If
Next
End With
wb.Close SaveChanges:=False
End If
file = Dir
Loop


From the subjected code, I could only copy the data from every workbook in the same folder, but not including the sub-folders, and the copying action is just copy the sheet name is "cost"now, if I wanna to copy all the shhets with same struction in every workbook also, how to amend the code, thanks for your help.
 
You need recursive search, an example with Scripting library: thread707-1787843.

combo
 
thnks COMBO, I WILL TRY TO SOLVE
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top