مسح بيانات بشرط

[ابوصلاح]

اريد مسح بيانات التلميذ المستبعد بعد ترحيله الى ورقة مستبعد فكل طالب

في العمود n   =مستبعد  يتم مسح بياناته من الخلية ( c:e)    و(k:r)   

الى اخر صف به بيانت

مسح البيانات.rar

[مختار حسين محمود]

 

جرب الكود التالى

Sub Export_del()
Dim CL As Range, i As Integer
With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
 End With
For i = 2 To 3
   For Each CL In Range("N11:N" & [N15000].End(xlUp).Row)
       If CL.Value = Sheets(i).Name Then
           CL.Offset(0, -11).Resize(1, 12).Copy Sheets(i).Range("C" & Sheets(i).[C15000].End(xlUp).Row + 1)
           CL.Offset(0, -11).Resize(1, 3).ClearContents
           CL.Offset(0, -3).Resize(1, 8).ClearContents
       End If
   Next
Next
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With

End Sub

 

[ابوصلاح]

Sub Export_del()
Dim CL As Range, i As Integer
With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
 End With
For i = 2 To 3
   For Each CL In Range("N11:N" & [N15000].End(xlUp).Row)
       If CL.Value = Sheets(i).Name Then
           CL.Offset(0, -11).Resize(1, 12).Copy
           Sheets(i).Range("C" & Sheets(i).[C15000].End(xlUp).Row + 1).PasteSpecial xlPasteValues
           CL.Offset(0, -11).Resize(1, 3).ClearContents
           CL.Offset(0, -3).Resize(1, 8).ClearContents
       End If
   Next
Next
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With

End Sub

الكود يعمل تماما

لكن تم التعديل للصق الخاص حتى تكون البيانات قيمة فقط

تم تعديل سبتمبر 17, 2016 بواسطه ابوصلاح