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

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

قام بنشر

وعليكم السلام

تفضل

Sub delete_redcells()
With ActiveSheet
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
    Range("A1").Select
    Selection.CurrentRegion.Select
    Selection.AutoFilter Field:=1, Criteria1:=RGB(255, 0 _
        , 0), Operator:=xlFilterCellColor
Range("a1").CurrentRegion.Select
Selection.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete

With ActiveSheet
If .AutoFilterMode Then
.AutoFilterMode = False
End If
End With
End Sub

 

  • Like 1
قام بنشر

بارك الله فيك استاذ شريف ولإثراء الموضوع هذا كود اخر:

Sub Delete_Rows()
    Dim cell        As Range
    Dim delRange    As Range
    Application.ScreenUpdating = False
        For Each cell In ThisWorkbook.Sheets(2).Range("A2:G" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row)
            If cell.DisplayFormat.Interior.ColorIndex = 3 Then
                If delRange Is Nothing Then Set delRange = cell Else Set delRange = Union(delRange, cell)
            End If
        Next cell
            If Not delRange Is Nothing Then delRange.EntireRow.Delete
    Application.ScreenUpdating = True
End Sub

 

  • Like 2
قام بنشر

جزاك الله كل خير استاذ شريف واستاذ على بارك الله فيكم فى الأكواد والحلول الرائعة

جعلة الله فى ميزان أعمالكما

  • 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