فتح شيت جديد بمجرد كتابة الإسم فى خلية

[Ali Mohamed Ali]

السلام عليكم أهل المنتدى الكرام

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

تقبلوا منى بارك الله فيكم وجزيتم خيرا

اكسل vba فتح شيت جديد بمجرد ادخال الاسم فى الخلية.xlsm

[الأستاذ / محمد الدسوقى]

أخى الحبيب على

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

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

حتى نتمكن من تطبيق الفكرة على ملفات مشابهة وتطويعها لأعمال أخرى

تقبل تحياتى

تم تعديل مارس 25, 2018 بواسطه الأستاذ / محمد الدسوقى

[سليم حاصبيا]

1 ساعه مضت, ali mohamed ali said:

السلام عليكم أهل المنتدى الكرام

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

تقبلوا منى بارك الله فيكم وجزيتم خيرا

اكسل vba فتح شيت جديد بمجرد ادخال الاسم فى الخلية.xlsm

الموضوع جيد و الى الامام 

لكن عندي ملاحظتين ارجو تقبلها:

1- لا ضرورة لتحديد صفحة مجمد ثم نسخها (يكفي نسخها فقط)

2-في حال ادراج اسم موجود في العامود  C او ان الخلية  فارغة   يحصل خطأ بالكود

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

ليبدو الكود يهذا الشكل

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cont%, lr
If Target.Column = 3 Then
lr = Sheets(1).Range("c" & Rows.Count).End(xlUp).Rows.Value
 cont = Application.CountIf(Range("c:c"), Target)
  If cont > 1 Or IsEmpty(Target) Then GoTo Exit_Me
Sheets("Mohamed").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = lr
Sheets(Sheets.Count).[b1].Value = lr
End If
Exit_Me:
End Sub

 

 

[Ali Mohamed Ali]

جزاك الله كل خير اخى الكريم الأستاذ محمد

هذا فيديو بالشرح :

 

وعليكم السلام اخى سليم دائما نصيحتك أستفاد منها كثيرا -جزاك الله كل خير

وهذا ما كان ينقص هذا الكود دائما تكمل لنا النقصان

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

تم تعديل مارس 25, 2018 بواسطه ali mohamed ali

[ام عبدالرحمن عوف]

تسلم - جزيت خيرا

[احمد عـــزام]

14 hours ago, سليم حاصبيا said:

الموضوع جيد و الى الامام 

لكن عندي ملاحظتين ارجو تقبلها:

1- لا ضرورة لتحديد صفحة مجمد ثم نسخها (يكفي نسخها فقط)

2-في حال ادراج اسم موجود في العامود  C او ان الخلية  فارغة   يحصل خطأ بالكود

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

ليبدو الكود يهذا الشكل

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cont%, lr
If Target.Column = 3 Then
lr = Sheets(1).Range("c" & Rows.Count).End(xlUp).Rows.Value
 cont = Application.CountIf(Range("c:c"), Target)
  If cont > 1 Or IsEmpty(Target) Then GoTo Exit_Me
Sheets("Mohamed").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).name = lr
Sheets(Sheets.Count).[b1].Value = lr
End If
Exit_Me:
End Sub

 

 

جزاك الله خيرا   ماشاء الله بارك الله فيكم جميعا..... طب ازاى اعمل هايبر لينك   

للصفحه  بمجرد ادخال الاسم فى العمود للذهاب الى تلك الصفحه

[احمد عـــزام]

17 hours ago, ali mohamed ali said:

السلام عليكم أهل المنتدى الكرام

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

تقبلوا منى بارك الله فيكم وجزيتم خيرا

اكسل vba فتح شيت جديد بمجرد ادخال الاسم فى الخلية.xlsm

رجاء شرح ازاى عملت هيبر لينك

[سليم حاصبيا]

جرب هذا الملف

Vice_versa Hyper.xlsm

[احمد عـــزام]

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

STORE-ITEM SSH2018.xlsm

[سليم حاصبيا]

تم معالجة الامر

 

STORE-ITEM SSH2018 salim.xlsm

[احمد عـــزام]

20 hours ago, سليم حاصبيا said:

جزاك الله خيرا   ..بالفعل الهايبر لينك  تم تفعيله لكن ظهرت مشكله 

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

ولم يعمل على الصفحه النشطه ,.... اعلم جيدا انى طلبت الكثير واثقلت علىكم ولكنى  لا ا املك الا الدعاء لكم جزاك الله خيرا 

مرفق الملف وموضح ماذا اريد 

 

STORE-ITEM SSH2018 salim.xlsm

[سليم حاصبيا]

المعادلات تعمل بشكل جيد عندي (لا اعلم ما السبب عندك)

 

STORE-ITEM SSH2018 salim1.xlsm

[احمد عـــزام]

بالفعل تم العمل بشكل جيد هذا مااريده بالفعل ................. شكرا شكرا شكرا ............ لك منى التحيه .... جزاك الله كل خير

 

[jalalbarakat]

السلام عليكم اخواني لدي مشكله في كتابة الاسم 

وبضل يعطيني new2  new3 

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Then
lr = Sheets(3).Range("d" & Rows.Count).End(xlUp).Rows.Value
Sheets("new").Select
Sheets("new").Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = lr
Sheets(Sheets.Count).[c3].Value = lr
End If
End Sub

[محمد سويد]

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

الله يعطيكم العافيه على المجهود العظيم كود في منتهى الروعة

انا طبقت الكود ولكن واجهت مشكله عندي في ملف الاكسل 3 اعمدة (التحركات اليومية + التحضير اليومي + التقارير اليومية )لمن حاولت اكرر الكود تجي رسالة خطاء وارفقت لكم الصور للكود اتمنى مساعدتي في عمل تكرار للكود وشكرا