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("A415")
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.
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("A415")
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.