اذهب الي المحتوي
أوفيسنا

برجاء المساعدة برز كود نسخ ولكن بشرط


الردود الموصى بها

الى خبراء واعضاء منتداى العزيز والعظيم

سلام الله عليكم ورحمته وبركاته ................. وكل عام وانتم بخير

مرفق ملف موضح به المطلوب .......... وجزاكم الله كل خير

وشكرا

زر كود نسخ بدون تكرار.rar

رابط هذا التعليق
شارك

الاخ الفاضل ابو الحسن

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

وانت مميز بردودك

وفقك الله

وهذا الكود المستخدم


Sub ALI()

Dim ALI_R  As Range, A As Range

Dim S As Worksheet, S1 As Worksheet

Application.ScreenUpdating = False

Dim ALI As Long

Set S = Sheets("Sheet1"): Set S1 = Sheets("Sheet2")

Set A = S1.Range("A2")

Set Z = S1.Range("A8:A5000")

ALI1 = ورقة2.Range("A15000").End(xlUp).Row + 1

S.Select

Set ALI_R = S.Range("A2:A5000").Find(what:=A, lookat:=xlWhole)

If Not ALI_R Is Nothing Then

For T = 7 To 5000

If Application.WorksheetFunction.CountIf(S1.Range("A2"), S1.Cells(T, 1)) = 1 Then MsgBox "السجل موجود", vbCritical, "تنبية !!!": S1.Select: Exit Sub

Next T

ALI_R.Resize(1, 6).Copy

ورقة2.Select

ورقة2.Range("A" & ALI1).PasteSpecial xlPasteValues

Application.CutCopyMode = False

Else

MsgBox "هذا الكود غير موجود في قادة البيانات", vbInformation, "تنبية !!!"

Exit Sub

End If

Application.ScreenUpdating = True

End Sub

تم تعديل بواسطه alidroos
رابط هذا التعليق
شارك

استاذى الرائع / ابو نصار

عمل رائع ويارب يخليك لنا ودائما تسعدنا بأعمالك الرائعة مثلك . وكما قال اخى ابو الحسن " رجل المهام الصعبة " .

ولكن لى ملحوظة هامة اوضحتها فى الملف المرفق مفادها باختصار اننى اريد انسخ من الورقة الثانية لان ممكن كود المدرسة يتكرر اكثر من مرة كما هو موضح بالورقة رقم 1 . وممكن ايضا الاختلاف يأتى مع القسم وليس شرط الاعتماد فقط على كود المدرسة . وهذة الملحوظة بالنسبة لى مهمة للحل .

الكود رائع ولكن استئذنك فى شرح وظيفة او دور RESIZE فى الكود .

انا شاكر مرورك الكريم واهتمامك فانت سباق دئما للخير

ارفقت ملف اوضحت فيه المطلوب بشكل اوضح

فى انتظار ردودكم الرائعة كالعادة

زر كود نسخ بدون تكرار 2.rar

رابط هذا التعليق
شارك

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

اذا كلو بيكون منه 2 اذا ماهو الشرط المراد ؟؟

لم استوعب ماتريد السموحه مزيد من التوضيح

والا ربما كالعادة السهر بيعمل عمايله معي :wink2:

رابط هذا التعليق
شارك

السلام عليكم

بعد اذن ابونصار

اخي فضل اليك هذه المعزوفة التي ستحقق ما تريد بإذن الله


Sub Abu_Ahmed_Filter()

Application.ScreenUpdating = False

Range("MyRng").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _

	"A1:A2"), CopyToRange:=Range("A7:F7"), Unique:=False

End Sub

كود نسخ بشرط 3.rar

رابط هذا التعليق
شارك

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

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

ولكن ياحبيبى وللاسف ليس هذا اللحن او المعزوفة المطلوبة .

ارفقت الملف موضح به المطلوب بالضبط

وانا فى انتظار المعزوفة المطلوبة بالضبط والتى اوضحتها جليا فى الملف المرفق .

بأمانة اسعدتنى كثيرا يامايسترو بحلولك الرائعة وفى انتظار ردك ومزيد من الابداع والجمال .

النسخ ولكن بشرط4.rar

تم تعديل بواسطه فضل 1
رابط هذا التعليق
شارك

سيدى الفاضل / ابو نصار

المقصود بالترحيل هنا اذا تم ترحيل كود المدرسة الموجود فى A2 مع القسم الموجود فى B2 مرة واحدة لايتم ترحيلهم مره ثانية لانهما ببساطة تم ترحيلهم مسبقا .

بمعنى اخر افترض اننى اخترت كود المدرسة مثلا 5 واخترت القسم مثلا اقتصاد فقمت بترحيلهم ........ هذه اول مره

وعندما اخترهم مره ثانية كود المدرسة 5 والقسم اقتصاد واطلب ترحيلهم مره اخرى يرفض زر الكود ويقول لى فى مربع رسالة ان تم ترحيل هذا الكود للمدرسة ومعه هذا القسم مسبقا ولايجوز الترحيل مرتين لنفس كود المدرسة والقسم .

يارب اكون وصلت الفكرة

شاكر لك سيدى الفاضل ابو نصار

وفى انتظار ردك

تم تعديل بواسطه فضل 1
رابط هذا التعليق
شارك

سيدى الفاضل / ابو نصار

المقصود بالترحيل هنا اذا تم ترحيل كود المدرسة الموجود فى A2 مع القسم الموجود فى B2 مرة واحدة لايتم ترحيلهم مره ثانية لانهما ببساطة تم ترحيلهم مسبقا .

بمعنى اخر افترض اننى اخترت كود المدرسة مثلا 5 واخترت القسم مثلا اقتصاد فقمت بترحيلهم ........ هذه اول مره

وعندما اخترهم مره ثانية كود المدرسة 5 والقسم اقتصاد واطلب ترحيلهم مره اخرى يرفض زر الكود ويقول لى فى مربع رسالة ان تم ترحيل هذا الكود للمدرسة ومعه هذا القسم مسبقا ولايجوز الترحيل مرتين لنفس كود المدرسة والقسم .

يارب اكون وصلت الفكرة

شاكر لك سيدى الفاضل ابو نصار

فى انتظار ردك الكريم

تم تعديل بواسطه فضل 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information