وعليكم السلام ... كان عليك لزاما عدم عمل تشتيت ورفع مشاركتك هنا أيضاً , طالما انك تحصلت بالفعل على كود الحل من قبل استاذنا الكبير سليم حاصبيا ... له منا كل المحبة والإحترام
Private Sub CommandButton2_Click()
Dim ws As Worksheet: Set ws = Sheets("inpout1")
Dim lr As Integer
Dim R, Ahe3b$, Hather$
Ahe3b = "غ": Hather = "حاضر"
ws.Range("ai5:ai500").ClearContents
lr = ws.Range("b" & Rows.Count).End(xlUp).Row
For R = 5 To lr
If ws.Cells(R, "B") <> vbNullString Then
If Application.CountIf(ws.Cells(R, "H").Resize(, 15), Ahe3b) >= 6 Then
ws.Cells(R, "AI") = "غائب"
Else
ws.Cells(R, "AI") = Hather
End If
End If
Next R
End Sub