Solution for Macro code if met criteria while pulling data from multiple workbooks

[manilara]

Need Help From Experts or Any One




I want macro code with met criteria conditions


One Master sheet pull data from multiple workbook named sheet in targeted folder,but not range of cell ,multiple dymensions cell values
Like

Application.DisplayAlerts = True


Dim wb As Workbook
Dim sht As Worksheet
Dim r As Integer


Set sht = ActiveSheet 'sheet for results
r = 2 '1st row
mydir = ActiveWorkbook.Path
myfile = Dir(mydir & "\" & "*.xls")
Do While Len(myfile) > 0
Set wb = Workbooks.Open(mydir & "\" & myfile)
fnd = False
For Each ws In wb.Sheets
If ws.Name = "New Proposed Checklist" Then fnd = True: Exit For
Next
If fnd Then
With wb.Sheets("New Proposed Checklist")
sht.Cells(r, 2) = wb.Name
sht.Cells(r, 3) = .Range("d3")
sht.Cells(r, 4) = .Range("d4")
sht.Cells(r, 5) = .Range("d5")
sht.Cells(r, 6) = .Range("d6")
sht.Cells(r, 7) = .Range("h3")
sht.Cells(r, 8) = .Range("h4")
sht.Cells(r, 9) = .Range("h5")
sht.Cells(r, 10) = .Range("h6")
sht.Cells(r, 11) = .Range("k3")
sht.Cells(r, 12) = .Range("k4")
sht.Cells(r, 13) = .Range("k5")
sht.Cells(r, 14) = .Range("k6")
sht.Cells(r, 15) = .Range("I5")

Here I want add code with criteria condition Like : If in every workbook in J1:J65000 any cell of column met "Yes" towards (I2:I65000 columns met criteria "A" or "B", or "C", or "D"), I want count value A,B,C,D in master cell 16,17,18,19 , Other than Yes Stop Code.
[/B]

sht.Cells(r, 16) = .Range("H1")
sht.Cells(r, 16) = .Range("H2").Application.WorksheetFunction.CountIf(Range("h:h"), "A")
sht.Cells(r, 17) = .Range("H1")
sht.Cells(r, 17) = .Range("H2").Application.WorksheetFunction.CountIf(Range("h:h"), "B")
sht.Cells(r, 18) = .Range("H1")
sht.Cells(r, 18) = .Range("H2").Application.WorksheetFunction.CountIf(Range("h:h"), "C")
sht.Cells(r, 19) = .Range("H1")
sht.Cells(r, 19) = .Range("H2").Application.WorksheetFunction.CountIf(Range("h:h"), "D")
End With
Else
MsgBox "Sheet Contains No Data " & wb.Name
End If
Application.DisplayAlerts = False
wb.Save
Application.DisplayAlerts = True
wb.Close Saved = True
Application.AskToUpdateLinks = False
ActiveWorkbook.Save
myfile = Dir
r = r + 1
Loop
MsgBox "File Fetching Completed"
End Sub