كود ترحيل بشروط

[بوعلام]

السلام عليكم ورحمة الله تعالى وبركاته

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

ارجوا المساعدة في عمل كود ترحيل بيانات عند تحقق الشرط من ورقة الحجز إلى الورقة الاجمالية

الشرح في المرفقات

الاستدراك.zip

تم تعديل أكتوبر 4, 2012 بواسطه بوعلام

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

ضع CommandButton في ورقة : حجز النقاط

اضف هذا الكود

الكود :

Private Sub CommandButton1_Click()

Dim LR, x

LR = [A10000].End(xlUp).Row

	 ورقة3.Range("A5:Q690").Value = ""

		 Application.ScreenUpdating = False

			 x = 5

				 For i = 11 To LR

					 If Cells(i, 17).Value >= 9 And Cells(i, 17).Value < 10 Then

					 Range("a" & i).Resize(1, 17).Copy

				 ورقة3.Range("A" & x).PasteSpecial xlPasteValues

			 Application.CutCopyMode = False

		 x = x + 1

	 End If

Next i

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

Application.ScreenUpdating = True

ورقة3.Select

End Sub[/size][/b]

[b][size=5]

[بوعلام]

السلام عليكم ورحمة الله تعالى وبركاته

شكرا جزيلا على سرعة تجاوبك أخي الكريم

لكن هناك مشكلة وهو عند تطبيق الجود لا يتم ترحيل التلميذ الأول "شوتري فراس " مع تحقق الشرط عليه فمعدله بين 9 و 9.99

أرجوا التعديل على الكود إن أمكن

[عبدالله المجرب]

السلام عليكم

في الكود الخاص باخي ابو حنين

استبدل هذا السطر

For i = 11 To LR

بهذا

For i = 6 To LR

[بوعلام]

بارك الله فيك اخي عبد الله

جعل الله ما تقومون به في ميزان حسناتكم ان شاء الله

[saad abed]

ابوحنين

بارك الله فيك اكوادك بها لمحات ممتازة

بارك الله فيك

سعد عابد

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

و جزاك الله خيرا أخي : / سعد عابد

و الشكر موصول لاخونا ابو احمد لتصحيحه الخطأ

[يوسف عطا]

ممكن شرح للكود أخونا الغالى أبو حنين ؟؟

[saad abed]

اخى يوسف عطا<

هذا الشرح حسب فهمى للكود واردت ان اكتبه ليصحح ابوحنين الاخطاء لاستفيد من تعليقاته

اشكركم

Private Sub CommandButton1_Click

اشارة للمتغيرينLR, x

Dim LR, x

تعريف المتغير lrوهو عبارة عن السطر الاخير حيث التحرك من اسفل لاعلى بداية من a10000حتى اخر سطر

LR = [A10000].End(xlUp).Row

المدى المشار اليه يساوى صفر (يفرغ)

ورقة3.Range(;A5:Q690;).Value =

عدم تحديث الشاشه

Application.ScreenUpdating = False

المتغيرx=5

x = 5

بداية الحلقة conter=بداية الصفوف 5الى اخر سطر وقد تم تعريفه

For i = 5 To LR

اف الشرطية بها شرطين متكاملين اصغرمن اوتساوى 9 واكبرمن10شرط الترحيل

If Cells(i, 17).Value >= 9 And Cells(i, 17).Value < 10 Then

هنا الخبرة تظهر حدد العمود aواستخدم اداة ربط النصوص ;والمتغيرiلاشارة الى a5ثم6وهكذا وريسيز للتحريك الى العمود 17ويقوم بالنسخ

Range("a" & i).Resize(1, 17).Copy

نفس الفكرة فى النسخ استخدمها ابو حنين فى اللصق لم يحدد بداية محدده بل ربطها بمتغير يبدا من 5 ويزداد 1

ورقة3.Range("A" & x).PasteSpecial xlPasteValues

اخرج من مود النسخ واللصق

Application.CutCopyMode = False

x = x + 1

End If

Next i

رسالة تفيد بان الترحيل تم

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

تحديث الشاشة

Application.ScreenUpdating = True

ورقة3.Select

End Sub

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

الشرح صحيح اخي سعد و ممتاز لكنني أريد زيادة تويضيح الجزئية التالية

ان اللصق يبتدأ من الصف 5 في الورقة الثانية لاننا قلنا : x = 5

بمعني لو قلنا : x = 10 لبدأ الصق من الصف 10

و الفكرة التي اريد توصيلها انه لا علاقة بين العدد 6 في السطر For i = 6 To LR مع العدد 5 في السطر x = 5

فالاول ( 6 ) خاص بصف النسخ و الثاني ( 5 ) خاص بصف الصق

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

جزاك الله خيرا أخي سعد على الشرح