ايقاف الكود عندما تكون الخلايا فارغة

If Sheet1.Range("A2").Value = "" Then MsgBox "اكتب التاريخ من فضلك", vbExclamation: Exit Sub

If Sheet1.Range("C2").Value = "" Then MsgBox "برجاء إدخال رقم الفاتورة", vbExclamation: Exit Sub

 For r = 3 To m

If Sheet1.cells(r,2).Value = "" Then MsgBox "برجاء إكمال البيانات", vbExclamation: Exit Sub

If Sheet1.Cells(r,2).Value="" Or Sheet1.Cells(r,4).Value=""  Then

Sub Test()

    Dim x, ws As Worksheet, sh As Worksheet, sName As String, r As Long, m As Long, n As Long, rng As Range

        Set rng = Sheet1.Range("A2")

    If rng.Value = "" Then MsgBox "اكتب التاريخ من فضلك", vbExclamation: Exit Sub

    If Sheet1.Range("C2").Value = "" Then MsgBox "برجاء إدخال رقم الفاتورة", vbExclamation: Exit Sub

        If Sheet1.Range("f2").Value = "" Then MsgBox "برجاء إدخال رقم المخزن", vbExclamation: Exit Sub

    'إيقاف اهتزاز الشاشة

    Application.ScreenUpdating = False

        'ورقة العمل المسماة صفحة الترحيل

        Set ws = Sheet1

        'المتغير لمعرفة رقم آخر صف به بيانات في العمود الثاني

        m = ws.Cells(Rows.Count, "B").End(xlUp).Row

        'حلقة تكرارية من الصف رقم 3 إلى آخر صف به بيانات

        For r = 3 To m

            If Sheet1.Cells(r, 2).Value = "" Then MsgBox "برجاء إكمال البيانات", vbExclamation: Exit Sub

    If Sheet1.Cells(r, 4).Value = "" Then MsgBox "برجاء إكمال البيانات", vbExclamation: Exit Sub

        If Sheet1.Cells(r, 5).Value = "" Then MsgBox "برجاء إكمال البيانات", vbExclamation: Exit Sub



            'متغير لتخزين اسم ورقة العمل التي سيتم الترحيل إليها

            sName = ws.Cells(r, 5).Value

            'التأكد من وجود ورقة العمل التي سيتم الترحيل إليها

            If Evaluate("ISREF('" & sName & "'!A1)") Then

                'تعيين ورقة العمل التي سيتم الترحيل إليها

                Set sh = ThisWorkbook.Worksheets(sName)

                'تحديد أول صف فارغ في ورقة العمل المراد الترحيل إليها لوضع البيانات بها

                n = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1

                With sh

                    'ترحيل التاريخ

                    .Cells(n, 1).Value = ws.Cells(2, 1).Value

                    'ترحيل الاسم

                    .Cells(n, 2).Value = ws.Cells(r, 2).Value

                    'ترحيل رقم الفاتورة

                    .Cells(n, 3).Value = ws.Cells(2, 3).Value

                    'معرفة رقم العمود الخاص بالمخزن ليتم إدراج المبلغ فيه

                    x = Application.Match(ws.Cells(2, 6).Value, sh.Rows(1), 0)

                    If Not IsError(x) Then

                        .Cells(n, x).Value = ws.Cells(r, 4).Value

                    End If

                End With

            Else

                Debug.Print "Worksheet " & sName & " Doesn't Exist"

            End If

        Next r

    'استعادة خاصية اهتزاز الشاشة

    Application.ScreenUpdating = True

            Range("A3:f24").ClearContents



    MsgBox "تم الترحيل بنجاح", 64, ""



End Sub