تعديل في كود ترحيل ومسح

[أبو عبد الملك السوفي]

السلام عليكم اساتذتنا الكرام

عندي كود ترحيل اريد تعديله والكود يقوم بترحيل البيانات من صفحة قاعدة البيانات الى مجمع النتائج الفصلية وبعد الترحيل يخيرك هل تريد مسح البيانات من صفحة قاعدة البيات ام لا  وهنا يأتي التعديل اريد من الكود ان يستثني بعض الاعمدة من المسح وهي   m  -q - r - t

Sub TransferDataMonth()
    Dim WS As Worksheet, SH As Worksheet
    Dim LR_WS As Long, LR_SH As Long
    Dim Answer As Long, X As Long
    
    Set WS = Sheets("ÝÇÚÏÉ ÇáÈíÇäÇÊ"): Set SH = Sheets("ãÌãÚ ÇáäÊÇÆÌ ÇáÝÕáíÉ")
    LR_WS = WS.Cells(Rows.Count, 1).End(3).Row
    LR_SH = SH.Cells(Rows.Count, 1).End(3).Row + 3
    X = LR_WS - 1
    
    Application.ScreenUpdating = False
    
        Answer = MsgBox("åá ÃäÊ ãÊÃßÏ ãä ÊÑÍíá ÇáÈíÇäÇÊ ãä æÑÞÉ ÇáÊÞÑíÑ ÇáÔåÑí Åáì æÑÞÉ ãÌãÚ ÇáäÊÇÆÌ ÇáÔåÑíÉ¿", vbInformation + vbMsgBoxRight + vbYesNo)
        
        If Answer = vbYes Then
           
            If LR_WS = 1 Then MsgBox "æÑÞÉ ÇáÊÞÑíÑ ÇáÔåÑí áíÓ ÈåÇ ÈíÇäÇÊ ááÊÑÍíá", vbInformation + vbMsgBoxRight: Exit Sub
            
            WS.Range("A5:aa" & LR_WS).Copy SH.Range("A" & LR_SH)
            Answer = MsgBox("ÇáÍãÏ ááå Êã ÇáÊÑÍíá ÈäÌÇÍ" & vbNewLine & "åá ÊÑíÏ ãÓÍ ÇáÈíÇäÇÊ Ýí æÑÞÉ ÇáÊÞÑíÑ ÇáÔåÑí¿", vbInformation + vbMsgBoxRight + vbYesNo)
            
            If Answer = vbYes Then
                WS.Range("h5:aa" & LR_WS).ClearContents
            Else: End If
            
        Else
            MsgBox "áÞÏ Êã ÅáÛÇÁ ÚãáíÉ ÇáÊÑÍíá", vbInformation + vbMsgBoxRight
        End If
        
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

برنامج المتابعة.rar

تم تعديل أكتوبر 20, 2016 بواسطه أبو عبد الملك السوفي

[ياسر خليل أبو البراء]

جرب التعديل في هذا الجزء

If Answer = vbYes Then
    WS.Range("h5:l" & LR_WS, "n5:p" & LR_WS, "s5:s" & LR_WS, "t5:aa" & LR_WS).ClearContents
Else: End If

 

[أبو عبد الملك السوفي]

السلام عليكم اولا بارك الله فيك استاذ ياسر

ثانيا التعديل يظهر خطأ في كلمة

 WS.Range

ويصبح عنوان الكود اصفر اين المشكل 

[ياسر خليل أبو البراء]

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

جرب التالي
 

If Answer = vbYes Then
    With Ws
        Union(.Range("h5:l" & Lr_Ws), .Range("n5:p" & Lr_Ws), .Range("s5:s" & Lr_Ws), .Range("t5:aa" & Lr_Ws)).ClearContents
    End With
Else: End If

 

[أبو عبد الملك السوفي]

السلام عليكم

بوركت استاذ ياسر الكود يعمل بشكل ممتاز

جزاك الله خيرا