محمد الورفلي1 قام بنشر يوليو 1, 2017 مشاركة قام بنشر يوليو 1, 2017 السلام عليكم اريد عدم الترحيل اذا كانت احدى خلايا العمود d فارغة Sub حفظ() Application.ScreenUpdating = False Dim Lr As Integer Lr = [A10000].End(xlUp).Row Range("A3:i" & Lr).Copy Sheets("مخزن").Range("A" & Sheets("مخزن").[A10000].End(xlUp).Row + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox "تم الحفظ بنجاح", vbOKOnly, "تنبية" Range("A3:e10000").ClearContents End Sub ترحيل بشرط.rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة ابراهيم الحداد قام بنشر يوليو 1, 2017 أفضل إجابة مشاركة قام بنشر يوليو 1, 2017 السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub حفظ() Application.ScreenUpdating = False Dim Lr As Integer, C As Range Lr = [A10000].End(xlUp).Row For Each C In Range("D3:D" & Lr) If C.Value = "" Then MsgBox "يوجد بعض البيانات الناقصة بعمود العدد" Exit Sub End If Next Range("A3:i" & Lr).Copy Sheets("مخزن").Range("A" & Sheets("مخزن").[A10000].End(xlUp).Row + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox "تم الحفظ بنجاح", vbOKOnly, "تنبية" Range("A3:e10000").ClearContents End Sub 1 رابط هذا التعليق شارك More sharing options...
محمد الورفلي1 قام بنشر يوليو 1, 2017 الكاتب مشاركة قام بنشر يوليو 1, 2017 7 دقائق مضت, زيزو العجوز said: السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub حفظ() Application.ScreenUpdating = False Dim Lr As Integer, C As Range Lr = [A10000].End(xlUp).Row For Each C In Range("D3:D" & Lr) If C.Value = "" Then MsgBox "يوجد بعض البيانات الناقصة بعمود العدد" Exit Sub End If Next Range("A3:i" & Lr).Copy Sheets("مخزن").Range("A" & Sheets("مخزن").[A10000].End(xlUp).Row + 1).PasteSpecial xlPasteValues Application.CutCopyMode = False MsgBox "تم الحفظ بنجاح", vbOKOnly, "تنبية" Range("A3:e10000").ClearContents End Sub تمام التمام شكراً بارك اله فيك رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.