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

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

الاخوه الكرام تحيه طيبه وبعد

ارجو المساعده فى هذا الشيBook1.rarت

[رجب جاويش]

تفضل أخى

Book2.rar

[الخالدي]

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

أيضا كود اخر وهو مقتبس من كود أخي الفاضل / رجب

يعمل الكود في حالة وجود فلتر في الورقة مع إظهار رسالة تنبيه في حال كانت بيانات الفلتر غير مصفاة

    Dim newsheet As Worksheet

    Dim rng As Range

    Dim sh As Worksheet

    Set rng = ActiveSheet.AutoFilter.Range

  If Not ActiveSheet.AutoFilterMode Then MsgBox "لا يوجد فلتر في الورقة": Exit Sub

  If Not ActiveSheet.FilterMode Then

	  M = MsgBox("بيانات الفلتر غير مصفاة" + vbCr + "هل ترغب في المتابعة على اي حال" & "", 4 + 32 + 524288 + 1048576, "تنبية")

	  If M = vbNo Then Exit Sub

  End If

    Set rng = ActiveSheet.AutoFilter.Range

    x = [f1].Value

    If x = "" Then MsgBox "الخلية فارغة اكتب اسم الشيت أولا ": Exit Sub

On Error GoTo Error:

	 If Sheets(x).Name = x Then MsgBox "هذا الاسم موجود من قبل", vbOKOnly, "اسم شيت مكرر": Exit Sub

Error:

    Set newsheet = Sheets.Add

    newsheet.Name = x

    rng.Copy newsheet.Range(rng.Cells(1).Address)[/size]

[size=4]

في امأن الله

Book3.rar

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

[mhrrd]

اخي الاسناذ الخالدي

شكرا لك

تظهر رساله مفادها ( هذا الاسم موجود فاذا تم التغيير في البيانات

واردنا نفس الشهر لانستطيع

نريد المسح اولا ثم الترحيل

*** ماهو التغيير اذا اردنا نقل عدد اكثر من الاعمدة ؟

***ماذا نفعل اذا اردنا ترحيل اعمدة معينه الى اعمدة معينة اخرى؟

بارك الله لك

[الخالدي]

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

اخي الكريم

شكرا وبارك الله لك

جرب الكود المرفق

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

وفي حال عدم وجود ورقة للشهر يتم عمل ورقة جديدة

يتم تسمية الورقة حسب الشهر في الفلتر

الكود يقوم بترحيل العمود الاول والثالث من الفلتر

في امأن الله

Book4.rar

[رجب جاويش]

أخى الحبيب / الخالدى

بسم الله ما شاء الله

ربنا يبارك فيك

مبدع كبير ولمساتك سحرية فى الأكواد

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

[mhrrd]

اريد تطويع هذا الكود السريع في ترحيل الناجحين والراسبين

حزاكم الله خيرا

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

الاخوه الكرام مشكورا لكم ابداعاتمك

وكن يواجهننى مشكله عند التطبيق

1-عند محاوله نسخ الشيت بالكامل تكون الصفحه الجديده خاليه من البيانات

2-اريد نسخ البيانات بالمعادلات

3 عند الضغط على زر شADD SHEET NAME ثم محاوله الخلوج يعطى اللاكسل رساله the picture is too large

فهل هذه الرساله توثر على عمل الشيت

مرفق اليكم الشيت الذى حاولت التطبيق عليهPAY HOTEL-1.rar