اذهب الي المحتوي
أوفيسنا

المساعدة فى الترحيل


إذهب إلى أفضل إجابة Solved by أبوأحـمـد,

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

السلام عليكم

السادة الأفاضل خبراء المنتدى تحية طيبة لكم

الرجاء مساعدتى فى عمل كود لترحيل الطلاب الذين قاموا بتحرير الاستمارة فقط إلى شيت أخر

اجتهدت بعض الشىء وقمت بعمل كود ولكن عند الترحيل يقوم بترحيل اسم واحد فقط من أخر الاسماء وليس أولها

لكم جزيل الشكر لمساعدتى

حرر.xlsm

رابط هذا التعليق
شارك

  • أفضل إجابة

تفضل

Private Sub CommandButton1_Click()
    Dim ws1, ws2, ws3 As Worksheet
    Dim lastRow, i, RowM2, RowM3 As Long
 
    Set ws1 = ThisWorkbook.Sheets("بيانات")
    Set ws2 = ThisWorkbook.Sheets("حرر")
    Set ws3 = ThisWorkbook.Sheets("لم يحرر")
     RowM2 = 8: RowM3 = 8
     
 ws2.Range("A8:D1000") = ""
 ws3.Range("A8:D1000") = ""
    lastRow = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row
     
    For i = 8 To lastRow
        
        If ws1.Cells(i, 5).Value = "حرر" Then
            ws2.Range("A" & RowM2 & ":D" & RowM2).Value = ws1.Range("A" & i & ":D" & i).Value
            RowM2 = RowM2 + 1
            Else
            ws3.Range("A" & RowM3 & ":D" & RowM3).Value = ws1.Range("A" & i & ":D" & i).Value
            RowM3 = RowM3 + 1
        End If
       
    Next i
End Sub

 

  • Like 1
  • Thanks 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