Sure. I have changed the font color of the code you provided me with. So all of the wbSrc workbooks are the workbooks within the subfolders that I will open, I just need help making the loop that tells the computer to go into each subfolder. Hope this helps, let me know if you need any clarifications
Dim report As Workbook
Dim savefilename As String
Set report = Workbooks.Add
savefilename = Application.GetSaveAsFilename(fileFilter:="Excel Files (*.xlsm), *.xlsm")
report.SaveAs savefilename, FileFormat:=52
FilePath = report.Path & "\"
Application.ScreenUpdating = False
Range("A2:D2").Value = Array("Start Date", "Start Time", "End Date", "End Time")
Range("F2").Value = "Total"
Range("E3").Value = "Test"
Range("E4").Value = "Retest"
Range("G2:M2").Value = Array("Passed", "Failed", "R WL", "R AM", _
"IR WL", "IR AM", "Therm")
Range("O2:X2").Value = Array("R WL", "Lower Limit", "Upper Limit", "IR WL", _
"Lower Limit", "Upper Limit", "Start Date", "Start Time", "End Date", "End Time")
'FT Formatting
Range("Y3").Value = "Test"
Range("Y4").Value = "Retest"
Range("AG3").Value = "Test"
Range("AG4").Value = "Retest"
Range("Z2:AF2").Value = Array("Total", "Passed", "Failed", "PD-Dark", "Vf-R", "PD-R", "S-R")
Range("AH2:AS2").Value = Array("Vf-IR", "PD-IR", "S-IR", "Shield", "S-PD", "Therm", "PD-R", "Lower Limit", "Upper Limit", _
"PD-IR", "Lower Limit", "Upper Limit")
Dim IsFolder As Boolean
Dim ParentFolder As String
Dim SubFolder As String
ParentFolder = FilePath
SubFolder = Dir(ParentFolder, vbDirectory)
Do While SubFolder <> ""
IsFolder = (GetAttr(ParentFolder & SubFolder) And vbDirectory) = vbDirectory
If IsFolder Then
Call OpenFiles(ParentFolder & SubFolder)
End If
SubFolder = Dir
'IP DATA
Dim wbSrc As Workbook
Dim wbSrc2 As Workbook
Dim wbSrc3 As Workbook
FileName = Dir(SubFolder & "*_IP.csv")
If Right$(UCase$(FileName), 9) = "RT_IP.CSV" Then FileName = Dir
Set wbSrc = Workbooks.Open(SubFolder & FileName)
wbSrc.ActiveSheet.Range("A2:B2").Copy report.ActiveSheet.Range("A3")
wbSrc.ActiveSheet.Range("A10000").End(xlUp).Copy report.ActiveSheet.Range("C3")
wbSrc.ActiveSheet.Range("B10000").End(xlUp).Copy report.ActiveSheet.Range("D3")
wbSrc.ActiveSheet.Columns("C").Copy report.ActiveSheet.Columns("O")
wbSrc.ActiveSheet.Columns("G").Copy report.ActiveSheet.Columns("R")
FileName3 = Dir(SubFolder & "*RT_IP-STATS.csv")
If Dir(FileName3) = FileName3 Then
Set wbSrc3 = Workbooks.Open(SubFolder & FileName3)
wbSrc3.ActiveSheet.Range("A2:H2").Copy report.ActiveSheet.Range("F4:M4")
wbSrc3.Close
Else:
End If
filename2 = Dir(SubFolder & "*_IP-STATS.csv")
' if same as previous then get next match
If filename2 = FileName3 Then filename2 = Dir
Set wbSrc2 = Workbooks.Open(SubFolder & filename2)
wbSrc2.ActiveSheet.Range("A2:H2").Copy report.ActiveSheet.Range("F3:M3")
'Setting Limits IP
report.Activate
Dim NumberCellsIP As Long
Set myRange = Columns("O")
NumberCellsIP = Application.WorksheetFunction.CountA(myRange)
ActiveSheet.Range("P3:P" & NumberCellsIP).Value = "656"
ActiveSheet.Range("Q3:Q" & NumberCellsIP).Value = "662"
ActiveSheet.Range("S3:S" & NumberCellsIP).Value = "880"
ActiveSheet.Range("T3:T" & NumberCellsIP).Value = "900"
'FINAL DATA
Dim wbSrc4 As Workbook
Dim wbSrc5 As Workbook
Dim wbSrc6 As Workbook
Filename4 = Dir(SubFolder & "*_FT.csv")
If Right$(UCase$(Filename4), 9) = "RT_FT.CSV" Then Filename4 = Dir
Set wbSrc4 = Workbooks.Open(SubFolder & Filename4)
wbSrc4.ActiveSheet.Range("A2:B2").Copy report.ActiveSheet.Range("U3")
wbSrc4.ActiveSheet.Range("A10000").End(xlUp).Copy report.ActiveSheet.Range("W3")
wbSrc4.ActiveSheet.Range("B10000").End(xlUp).Copy report.ActiveSheet.Range("X3")
wbSrc4.ActiveSheet.Columns("E").Copy report.ActiveSheet.Columns("AN")
wbSrc4.ActiveSheet.Columns("H").Copy report.ActiveSheet.Columns("AQ")
FileName6 = Dir(SubFolder & "*RT_FT-STATS.csv")
If Dir(FileName6) = FileName6 Then
Set wbSrc6 = Workbooks.Open(SubFolder & FileName6)
wbSrc6.ActiveSheet.Range("A2:G2").Copy report.ActiveSheet.Range("Z4:AF4")
wbSrc6.ActiveSheet.Range("H2:M2").Copy report.ActiveSheet.Range("AH4")
wbSrc6.Close
Else:
End If
filename5 = Dir(SubFolder & "*_FT-STATS.csv")
If filename5 = FileName6 Then filename5 = Dir
Set wbSrc5 = Workbooks.Open(SubFolder & filename5)
wbSrc5.ActiveSheet.Range("A2:G2").Copy report.ActiveSheet.Range("Z3:AF3")
wbSrc5.ActiveSheet.Range("H2:M2").Copy report.ActiveSheet.Range("AH3")
Loop
End Sub
Bookmarks