جرب هذا الكود
ليعمل الكود بشكل جيد يجب ازالة الخلايا المدمجة من صفحة البيانات في الصف الاول
Sub Translate_Data()
Dim rg_to_copy As Range
Dim lr As Integer
Dim m As Integer
m = 0
Application.ScreenUpdating = False
On Error Resume Next
Sheets("النتائج").Cells.ClearContents
lr = Application.Max(Sheets("البيانات").Range("A:A"))
For I = 1 To lr
If Sheets("البيانات").Cells(I + 7, "O") = "اوفسينا" Then
With Sheets("البيانات")
.Select
Set rg_to_copy = Union(.Range(Cells(I + 7, 1), Cells(I + 7, 4)), .Range(Cells(I + 7, 15), Cells(I + 7, 17)), _
.Range(Cells(I + 7, 26), Cells(I + 7, 28)))
End With
rg_to_copy.Copy
Sheets("النتائج").Cells(m + 1, 1).PasteSpecial
m = m + 1
End If
Next
Sheets("النتائج").Range("b:b").SortSpecial
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub