خطأ عند الترحيل

[mohamadhaje]

السلام عليكم ورحمة الله وبركاته ارجو المساعدة في تصحيح الخطأ في عملية الترحيل

ترحيل1.xlsm

[mohamadhaje]

 

Sub Button1_Click()
On Error Resume Next
If Range("a13") = "" Or Range("b13") = "" Or Range("c13") = "" Then
MsgBox "ÈÑÌÇÁ ÇßãÇá ÇáÈíÇäÇÊ", vbDefaultButton1, "ßæÏ ÇáÊÑÍíá "
Else

azsh = ãÈíÚÇÊ.Range("c50000").End(xlUp).Row + 1
æÇÌåÉ.Range("A3:AA13").Copy
ãÈíÚÇÊ.Cells(azsh, 1).PasteSpecial Paste:=xlPasteValues
MsgBox "Êã ÈäÌÇÍ", vbDefaultButton1, "ßæÏ ÇáÊÑÍíá "
æÇÌåÉ.Range("A13:AA13") = ""
End If

End Sub

 

مشكور هذا الكود

 

ترحيل1.xlsm

تم تعديل يناير 28 بواسطه mohamadhaje
.

[محمد هشام.]

Sub Test()
Dim lr As Long, r As Range
Dim ws As Worksheet: Set ws = Worksheets("واجهة")
Dim Wdst As Worksheet: Set Wdst = Worksheets("مبيعات")

Const Check = "A13:C13": Set r = ws.Range(Check): Rng = ws.[A3:AA13].Value
lr = Wdst.Cells(Rows.Count, 3).End(xlUp).Row + 1

If Application.WorksheetFunction.CountA(r) < r.Count Then
    MsgBox "برجاء اكمال البيانات", vbExclamation, "كود الترحيل "
     Exit Sub
  Else
   Wdst.Range("A" & lr).Resize(UBound(Rng), UBound(Rng, 2)).Value2 = Rng
       ws.[A13:AA13] = Empty
        MsgBox "تم بنجاح", vbInformation, "كود الترحيل "
   End If
End Sub

 

ترحيل1 V1.xlsm

[mustafa khatab]

اخى محمد هشام , الرجاء المساعده فى اخر موضوه لى جزاك الله خير , لا استطيع ارسال رساله فى الخاص