اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم

تفضل أخى

Sub TARHIL()
Dim Sh As String
Dim i As Integer
Dim AA As Integer
'======================================================
Application.ScreenUpdating = False
Sheets("ناجح").Range("A12:X1000").ClearContents
Sheets("دور ثان").Range("A12:X1000").ClearContents
Sheets("راسب").Range("A12:X1000").ClearContents
'======================================================
For i = 12 To Cells(10000, "Y").End(xlUp).Row
    Sh = Cells(i, "Y").Value
    AA = Sheets(Sh).Cells(10000, 2).End(xlUp).Row + 1
    If AA < 12 Then AA = 12
    On Error Resume Next
    Range(Cells(i, "B"), Cells(i, "X")).Copy
    Sheets(Sh).Range("B" & AA).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Sheets(Sh).Cells(AA, "A").Value = Sheets(Sh).Cells(AA, "A").Row - 11
Next i
Application.ScreenUpdating = True
MsgBox "تم الفصل بنجاح"
End Sub

 

الترحيل1.rar

  • Like 1

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information