ترحيل يومية مع مسح البيانات

[حمدي]

السلام عليكم إخواني الاعزاء

بارك الله فيكم و في القائمين على منتدانا الكريم الزاخر بالخبراء و المبدعين حفظهم الله و زادهم علما على علمهم و نفع بهم و جعل ما يقدمونه من علم في ميزان حسناتهم

و في البداية اتقدم بالشكر  لكل من ساهم في مساعدتي و مساعدة غيري و أخص بالذكر اساتذني الكرام

الاستاذ رجب جاويش

الاستاذ عبد الله المجرب

الاستاذ عبد الله باقشير

الاستاذ  طارق محمود

الاستاذ  جمال عبد السميع

الاستاذ حمادة عمر

الاستاذ  أبو حنين

باقي الاساتذة عباقرة المنتدى جزاهم الله عنا خيرا

و الآن عندي ملف عبارة كشفين الكشف الأول يتم فيه تفريغ الفواتير اليومية للمبيعات و الكشف الثاني فيه كل فواتير المبيعات لكل الايام

و المطلوب ترحيل الفواتير اليومية مع مسحها لاعادة كتابة فواتير اخري ليوم آخر في هذا الكشف

و لقد بحثت كثيرا في المنتدى و كل ما وجدته هو ترحيل بدون مسح 

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

ترحيل يومية.rar

[أبو حنــــين]

السلام عليكم

أضف موديل و انسخ هذا الكود في الموديل و ضع له زر لتشغيله

Sub AbouHanin()
Dim LR As Integer, x As Integer
'----------------------------------------------------------------------
LR = ورقة1.Cells(Rows.Count, "B").End(xlUp).Row
LR1 = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
'----------------------------------------------------------------------
If ورقة1.Range("B7").Value = "" Then Exit Sub
x = 8
For i = 7 To LR
'----------------------------------------------------------------------
        Range("C" & i).Resize(1, 15).Copy
        ورقة2.Range("C" & LR1 + x - 7).PasteSpecial xlPasteValues
        ورقة2.Range("B" & LR1 + x - 7) = LR1 + x - 13
'----------------------------------------------------------------------
        Application.CutCopyMode = False
        x = x + 1
Next i
 With ورقة1
.Range("B7:P" & LR).ClearContents
End With
Last = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
 ورقة1.Range("C7").Value = Val(ورقة2.Range("C" & Last).Value) + 1
  ورقة1.Range("B7").Value = 1
Application.ScreenUpdating = True
End Sub

تم تعديل يونيو 13, 2013 بواسطه أبو حنين

[إبراهيم ابوليله]

اخى ابو حنين

كود رائع ومتقن

كما تعودنا منك

ولكن مامعنى هذا الشطر

 ورقة2.Range("B" & LR1 + x - 7) = LR1 + x - 13

[أبو حنــــين]

أخي ابراهيم السلام عليكم و رحمة الله

هذا الشطر للحفاظ على الترتيب التصاعدي  في العمود  B    :   أي   1 ’ 2 ، 3 ، 4 ، ........... إبتداءا من الخلية  B7

[إبراهيم ابوليله]

اخى ابو حنين

مشكورا على الرد

بارك الله فيك

[حمدي]

جزاك الله خيرا و بارك الله فيك أخي ابو حنين

كود رااااااااااائع جدا و هذا ما تعودناه فيك دائما بابداعاتك

كثر الله من امثالك و زادك الله من علمه

لكن لا تتم عملية الترحيل الا في الحالة الاولى فقط و عندما قمت باضافة بيانات جديدة لا يحدث ترحيل الا للصف الاول فقط

[أبو حنــــين]

اخي حمدي

جربت الترحيل و هو يعمل عندي

انظر المرفق 2003

ترحيل يومية1.rar

[حمدي]

عفوا اخي ابو حنين

لاني لم اكن رقمت الفواتير

الكود يعمل على أكمل وجه

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

بس في ملاحظة و هي اهتزاز الملف اثناء الترحيل خاصة اذا كانت الفواتير كثيرة

[حمدي]

ايضا العمود قبل الاخيرفيه معادلة تم مسحها و هي معادلة المطلوب - المدفوع

[أبو حنــــين]

بعدما اعددت الرد  انقطع التيار فجأة

غير الكود السابق بالكود التالي لمنع الاهتزار

Sub AbouHanin()

Dim LR As Integer, x As Integer
Application.ScreenUpdating = False
LR = ورقة1.Cells(Rows.Count, "B").End(xlUp).Row
LR1 = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
'----------------------------------------------------------------------
If ورقة1.Range("B7").Value = "" Then Exit Sub
x = 8
For i = 7 To LR
'----------------------------------------------------------------------
        Range("C" & i).Resize(1, 15).Copy
        ورقة2.Range("C" & LR1 + x - 7).PasteSpecial xlPasteValues
        ورقة2.Range("B" & LR1 + x - 7) = LR1 + x - 13
'----------------------------------------------------------------------
        x = x + 1
Next i
 With ورقة1
.Range("B7:P" & LR).ClearContents
End With
Last = ورقة2.Cells(Rows.Count, "B").End(xlUp).Row
 ورقة1.Range("C7").Value = Val(ورقة2.Range("C" & Last).Value) + 1
  ورقة1.Range("B7").Value = 1
Application.ScreenUpdating = True
End Sub

بالنسبة للسؤال الثاني

لا اعرف موقع المعادلة و لم أرها

فإن كانت في العمود مثلا L غير فقط هذا السطر

 

Range("C" & i).Resize(1, 15).Copy

بهذا السطر

Range("C" & i).Resize(1, 9).Copy

و ان كانت المعادلة في عمود آخر غير فقط الرقم 10 الى رقم آخر بحث :

تبتدأ الحساب من العمود C وصولا الى العمود الذي يحتوي على المعادلة

مثال :

المعادلة موجودة في العمود H  فيصبح بدلا من العدد 10 العدد 5 و تكون بذلك الخلية H غير معنبة بالترحيل

[حمدي]

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

بسم الله ما شاء الله عليك

هذاهو المطلوب

[حمدي]

طلب اخير استاذي ابو حنين

عدم حدوث عملية الترحيل الا اذا كانت كل الخانات ممتلئة

و ظهور رسالة لاستكمال البيانات