مطلوب تعديل كود حذف الصف

[عبدالله باقشير]

السلام عليكم

الكود ماشاء الله تمام جدااا

بس احتاج تعديل لكى يقوم بالحذف اول بأول دون تجميع للخلايا

ممكن استاذنا

جرب الكود التالي:

Option Explicit


Sub Kh_Find_Delete()

Dim MyTextFind, kh_msg

Dim MySh As Worksheet

Dim C As Range, CC As Range

Dim FirstAddress As String

Dim Tb As Boolean

MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث في جميع الاوراق الظاهرة")

If MyTextFind = "" Or MyTextFind = False Then Exit Sub


For Each MySh In ActiveWorkbook.Worksheets

    If MySh.Visible = xlSheetVisible Then

1:

        With MySh.Cells

            Set C = .Find(MyTextFind, LookIn:=xlValues)

            If CC Is Nothing Then Tb = True Else If Intersect(CC, C) Is Nothing Then Tb = True Else Tb = False

            If Not C Is Nothing And Tb Then

                FirstAddress = C.Address

                Do

                    MySh.Activate

                    C.Select

                    '-------------------------

                    kh_msg = MsgBox("تم ايجاد قيمة البحث في العنوان  " & C.Address & Chr(10) & Chr(10) & "قيمة البحث هي:   " & C.Value _

                            & Chr(10) & Chr(10) & "هل تريد حذف الصف   ؟", 524288 + 1048576 + 256 + 3, "النتائج في:   " & MySh.Name)

                    Select Case kh_msg

                        Case 2: GoTo kh_Exit

                        Case 6: C.EntireRow.Delete: GoTo 1

                        Case 7: If CC Is Nothing Then Set CC = C Else Set CC = Union(CC, C)

                    End Select

                    '-------------------------

                    Set C = .FindNext(C)

                Loop While Not C Is Nothing And C.Address <> FirstAddress

            End If

        End With

    End If

    Set CC = Nothing

Next MySh

MsgBox IIf(Len(FirstAddress), "انتهى البحث", "لا توجد نتائج للبحث "), 524288 + 1048576, "بحث"

kh_Exit:

Set C = Nothing

End Sub

واخبرني بالنتيجة

[abouelhassan]

الله يرضى عنك

استاذنا

خبور الخير بارك الله لك وبك ورزقك كل الخير

هذا هو العمل تمام التمام ماشاء الله عليك

الله يعزك ويبارك لك أمين

احترامى