طلب تصحيح كود ترحيل بيانات

[احمد عبد الفتاح]

الى الأخوة المحترمون خبراء الاكسيل بهذا المنتدى الرائع العظيم

أرجو منكم المساعدة العاجلة فى تصحيح هذا الكود لترحيل البيانات مع مسح البيانات المرحلة

() Sub OFFICNA1

Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet

Set ws = Sheets("1")

Set ws2 = Sheets("1")

LR = ws.Range("a" & Rows.Count).End(xlUp).Row

LR2 = ws2.Range("co" & Rows.Count).End(xlUp).Row

If ws.Range("a9").Value = "" Then

("لا توجد بيانات لترحيلها") MsgBox

End If

Dim c

("تحذير",36 ,"أنت بصدد ترحيل جميع السجلات الى الأرشيف فهل توافق ؟") c = MsgBox

If c = 6 Then

ws.Range("a9:l" & LR).Copy ws2.Range("co" & LR2 + 1)

ws.Range("a9:l" & LR).ClearContents

ws.Select

"تم الترحيل", vbInformation + vbMsgBoxRight, "تم الترحيل بنجاح!" MsgBox

End If

End Sub

المطلوب من هذا الكود أن يقوم بترحيل البيانات مع مسح البيانات المرحلة ، ولكن اذا كانت أول خلية فارغة من البيانات يعطى رسالة " لا توجد بيانات لترحيلها " ويتم انتهاء العملية .

واذا كانت البيانات موجودة يتم استكمال الكود برسالة تحذير "أنت بصدد ترحيل جميع السجلات الى الأرشيف فهل توافق ؟" فإذا تم اختيار موافق يتم نقل البيانات مع مسحها من موضعها الاصلى ، واذا تم اختيار غير موافق أو NO يتم انتهاء الرسالة وانتهاء الكود .

لذا أرجو من حضراتكم مساعدتى لاتمام هذا الكود على الوجه الصحيح

حيث يعطينى الرسالة الاولى بأن الخلايا لا يوجد بها بيانات ثم يعطينى الرسالة التحذيرية الثانية ،

والمطلوب أنه اذا كانت الخلايا فارغة أن يعطينى الرسالة الأولى فقط وينتهى عند ذلك الحد .

ومرفق الملف نفسه للتجربة والتوضيح

ولكم جزيل الشكر ...

برنامج الكيماويات.rar

تم تعديل مارس 30, 2013 بواسطه احمد عبد الفتاح

[احمد عبد الفتاح]

مطلوب الرد لو سمحتوا - 13 مشاهدة ولا اى رد

برجاء الاهتمام والمساعدة

[احمد عبد الناصر]

السلام عليكم

 

 

جرب هذا 

 

Sub OFFICNA1()
Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("1")
Set ws2 = Sheets("1")
LR = ws.Range("a" & Rows.Count).End(xlUp).Row
LR2 = ws2.Range("co" & Rows.Count).End(xlUp).Row
If ws.Range("a9").Value = "" Then
MsgBox ("áÇ ÊæÌÏ ÈíÇäÇÊ áÊÑÍíáåÇ")
Exit Sub
End If
Dim c
c = MsgBox("ÃäÊ ÈÕÏÏ ÊÑÍíá ÌãíÚ ÇáÓÌáÇÊ Çáì ÇáÃÑÔíÝ Ýåá ÊæÇÝÞ¿", 36, "ÊÍÐíÑ")
If c = 6 Then
ws.Range("a9:l" & LR).Copy ws2.Range("co" & LR2 + 1)
ws.Range("a9:l" & LR).ClearContents
ws.Select
MsgBox "Êã ÇáÊÑÍíá ÈäÌÇÍ!", vbInformation + vbMsgBoxRight, "Êã ÇáÊÑÍíá"
End If
End Sub

 

الفكرة في اضافة  Exit Sub

 

تحياتي

[احمد عبد الفتاح]

السلام عليكم

 

 

جرب هذا 

 

Sub OFFICNA1()
Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("1")
Set ws2 = Sheets("1")
LR = ws.Range("a" & Rows.Count).End(xlUp).Row
LR2 = ws2.Range("co" & Rows.Count).End(xlUp).Row
If ws.Range("a9").Value = "" Then
MsgBox ("áÇ ÊæÌÏ ÈíÇäÇÊ áÊÑÍíáåÇ")
Exit Sub
End If
Dim c
c = MsgBox("ÃäÊ ÈÕÏÏ ÊÑÍíá ÌãíÚ ÇáÓÌáÇÊ Çáì ÇáÃÑÔíÝ Ýåá ÊæÇÝÞ¿", 36, "ÊÍÐíÑ")
If c = 6 Then
ws.Range("a9:l" & LR).Copy ws2.Range("co" & LR2 + 1)
ws.Range("a9:l" & LR).ClearContents
ws.Select
MsgBox "Êã ÇáÊÑÍíá ÈäÌÇÍ!", vbInformation + vbMsgBoxRight, "Êã ÇáÊÑÍíá"
End If
End Sub

 

الفكرة في اضافة  Exit Sub

 

تحياتي

الف شكر لحضرتك

انا عاجز عن الشكر - فعلا الحل بسيط ورائع

وشكرا لاهتمامك 

[احمد عبد الناصر]

استاذ احمد عبد الفتاح حياك الله

 

زادك الله علما و نفع بك 

 

 إِنَّ اللَّهَ مَعَ الصَّابِرِينَ      

 

تحياتي

[احمد عبد الفتاح]

استاذ احمد عبد الفتاح حياك الله

 

زادك الله علما و نفع بك 

 

 إِنَّ اللَّهَ مَعَ الصَّابِرِينَ      

 

تحياتي

استاذ احمد عبد الناصر

لى استفسار بسيط لو سمحت

قمت بتصميم برنامج للمخازن على الاكسيل وقمت بعمل 170 موديول Module فى هذا البرنامج - وحجم ملف الاكسيل حوالى 11.5 ميجا بايت

المشكلة هنا هى ان الملف ثقيل جدااااا وبيأخذ وقت طويل عند الفتح وعند الحفظ ( Save ) 

أرجو ارشادى للطريقة الصحيحة حتى يصبح البرنامج خفيفا" على المستخدم وسهل الفتح والحفظ والغلق

مع العلم انه لا يمكننى الاستغناء عن هذا العدد الكبير من الموديولات

ولكم جزيل الامتنان والشكر

[احمد عبد الفتاح]

استاذ احمد عبد الناصر

لى استفسار بسيط لو سمحت

قمت بتصميم برنامج للمخازن على الاكسيل وقمت بعمل 170 موديول Module فى هذا البرنامج - وحجم ملف الاكسيل حوالى 11.5 ميجا بايت

المشكلة هنا هى ان الملف ثقيل جدااااا وبيأخذ وقت طويل عند الفتح وعند الحفظ ( Save ) 

أرجو ارشادى للطريقة الصحيحة حتى يصبح البرنامج خفيفا" على المستخدم وسهل الفتح والحفظ والغلق

مع العلم انه لا يمكننى الاستغناء عن هذا العدد الكبير من الموديولات

ولكم جزيل الامتنان والشكر

[احمد عبد الفتاح]

السلام عليكم

 

 

جرب هذا 

 

Sub OFFICNA1()
Dim LR As Long, LR2 As Long, ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("1")
Set ws2 = Sheets("1")
LR = ws.Range("a" & Rows.Count).End(xlUp).Row
LR2 = ws2.Range("co" & Rows.Count).End(xlUp).Row
If ws.Range("a9").Value = "" Then
MsgBox ("áÇ ÊæÌÏ ÈíÇäÇÊ áÊÑÍíáåÇ")
Exit Sub
End If
Dim c
c = MsgBox("ÃäÊ ÈÕÏÏ ÊÑÍíá ÌãíÚ ÇáÓÌáÇÊ Çáì ÇáÃÑÔíÝ Ýåá ÊæÇÝÞ¿", 36, "ÊÍÐíÑ")
If c = 6 Then
ws.Range("a9:l" & LR).Copy ws2.Range("co" & LR2 + 1)
ws.Range("a9:l" & LR).ClearContents
ws.Select
MsgBox "Êã ÇáÊÑÍíá ÈäÌÇÍ!", vbInformation + vbMsgBoxRight, "Êã ÇáÊÑÍíá"
End If
End Sub

 

الفكرة في اضافة  Exit Sub

 

تحياتي

 

 

 

 

استاذ احمد عبد الناصر

لى استفسار بسيط لو سمحت

قمت بتصميم برنامج للمخازن على الاكسيل وقمت بعمل 170 موديول Module فى هذا البرنامج - وحجم ملف الاكسيل حوالى 11.5 ميجا بايت

المشكلة هنا هى ان الملف ثقيل جدااااا وبيأخذ وقت طويل عند الفتح وعند الحفظ ( Save ) 

أرجو ارشادى للطريقة الصحيحة حتى يصبح البرنامج خفيفا" على المستخدم وسهل الفتح والحفظ والغلق

مع العلم انه لا يمكننى الاستغناء عن هذا العدد الكبير من الموديولات

ولكم جزيل الامتنان والشكر

[احمد عبد الناصر]

السلام عليكم

 

معذرة لا اعلم حل لهذه المشكلة .

 

من الممكن ان يكون هناك حل مؤقت لتسريع الملف قليلا و هذا يحتاج الاطلاع علي الملف .

 

او اعادة تصميم الملف من البداية بطريقة تجعله خفيف و سريع و دقيق (هذا الحل الاصعب).

 

اعتقد انه من الافضل ان ترفق الملف في موضوع جديد و ستجد من الاخوة الاعضاء و الاساتذة الخبراء حل او حلول لهذه المشكلة .

 

و الله اعلم

 

تحياتي