Sub TrStuds()
Dim i As Long, C As Range
Dim Rng As Range, x As Integer
LR = Sheets("قائمة نصف السنة").Range("A" & Rows.Count).End(3).Row
Set Rng = Range("T7:T14")
x = WorksheetFunction.CountA(Rng)
If x = 0 Then
MsgBox "لا توجد اسماء لترحيلها . اكتب الاسماء اولا ثم اضغط زر ترحيل !!"
Exit Sub
End If
i = 7
Do While Range("R" & i) <> Empty
For Each C In Range("A7:A" & LR)
If C.Value = Range("R" & i) Then
C.Offset(0, 1) = Range("R" & i).Offset(0, 1)
C.Offset(0, 2) = Range("R" & i).Offset(0, 2)
End If
Next
i = i + 1
Loop
End Sub