المتأمل الحسني قام بنشر مايو 29, 2015 مشاركة قام بنشر مايو 29, 2015 السلام عليكم و رحمة الله ... أرجو من الإخوة مساعدتي في عمل كود ينسخ بيانات نطاق معين بناء على إسم في هذا النطاق ثم يلصقه في ورقة جديدة و يسميها بنفس الإسم الذي في النطاق .... كما في المرفق . و لكم جزيل الشكر probl.rar رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر مايو 29, 2015 مشاركة قام بنشر مايو 29, 2015 تم معالجة الامر بدون كود فقط بواسطة المعادلات وهي (مطاطة يمكنك اضافة او تغيير البيانات) probl salim.rar 2 رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر مايو 30, 2015 أفضل إجابة مشاركة قام بنشر مايو 30, 2015 الأخ الفاضل يرجى تغيير اسم الظهور للغة العربية بارك الله فيك أخي الحبيب الغالي سليم حاصبيا إثراءاً للموضوع هذا حل آخر بالأكواد .. Sub AddDataToSheets() Dim Cell As Range, Header As Range, Rng As Range, EndRng As Range Dim row As Long, NextRow As Long Dim Wks As Worksheet, SH As Worksheet Set Wks = Worksheets("ورقة1") Set Header = Wks.Range("A10:P12") Set Rng = Wks.Range("A13:M13") Set EndRng = Wks.Cells(Rows.Count, "M").End(xlUp) If EndRng.row > Rng.row Then Set Rng = Rng.Resize(EndRng.row - Rng.row + 1) Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Application.DisplayAlerts = False For Each SH In Worksheets If SH.Name <> Wks.Name Then SH.Delete Next SH For row = 1 To Rng.Rows.Count Set Cell = Rng.Cells(row, "M") If Not IsEmpty(Cell) Then On Error Resume Next Set Wks = ThisWorkbook.Worksheets(Cell.Text) If Err = 9 Then Worksheets.Add After:=Worksheets(Worksheets.Count) Set Wks = ActiveSheet Wks.Name = Cell.Text Header.Copy Wks.Paste Wks.Cells(1, 1) End If NextRow = Wks.Cells(Rows.Count, "M").End(xlUp).row + 1 Rng.Rows(row).Copy Wks.Rows(NextRow) On Error GoTo 0 End If Next row Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub تقبل تحياتي Create Sheets Based On Values In Range YasserKhalil.rar 2 رابط هذا التعليق شارك More sharing options...
أسامة البراوى قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 السلام عليكم ارى ان هذا حل جميل ويفى بالغرض وممكن ان نضيف الاسطر التالية فى نهاية الكود لكى نحافظ على الشكل العام للشيتات الجديدة Dim I As Intger For Each SH In Worksheets If SH.Name <> "ورقة1" Then For I = 1 To 6 SH.Columns(I).ColumnWidth = Sheets("ورقة1").Columns(I).ColumnWidth Next End If Next SH 2 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 إضافة في منتهى الجمال والروعة تسلم يا مستر أسامة .. شكلك هتبدع في المنتدى في انتظار المزيد من إبداعاتك رابط هذا التعليق شارك More sharing options...
أسامة البراوى قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 ربنا يكرمك يا استاذ ياسر انا فقط باحاول اساعد لان فعلا هذا المنتدى جميل ورائع وبصراحة بيضيف كتير لمعلومات الواحد، فاتمنى تكون مشاركاتى مفيدة للجميع 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 ربنا يكرمك يا استاذ ياسر انا فقط باحاول اساعد لان فعلا هذا المنتدى جميل ورائع وبصراحة بيضيف كتير لمعلومات الواحد، فاتمنى تكون مشاركاتى مفيدة للجميع أنا لي وجهة نظر وعمرها إن شاء الله ما بتخيب ... الأخوة في المنتدى سيستفيدون منك بشكل كبير جداً وأنا أولهم بس يا ريت متنسناش يا كبير .. تقبل ودي وحبي وتحياتي :fff: رابط هذا التعليق شارك More sharing options...
المتأمل الحسني قام بنشر مايو 30, 2015 الكاتب مشاركة قام بنشر مايو 30, 2015 ما شاء الله على الجميع .. لساني عاجز عن شكر الجميع .. فقد أثريتم الموضوع كل بجمال قدراته و ذكائه .. لا حرمني الله منكم جميعا ... و يعلم الله انني ادعو لكم دائما بالتوفيق و أن يجزيكم الله خيرا... اشكركم جدا .... رابط هذا التعليق شارك More sharing options...
المتأمل الحسني قام بنشر مايو 30, 2015 الكاتب مشاركة قام بنشر مايو 30, 2015 الإخوة الفضلاء : أتسائل هل بالإمكان نسخ البيانات ك " قيم" من غير الدوال ؟ رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 الأخ الكريم يرجى تغيير اسم الظهور للغة العربية استبدل السطر التالي Rng.Rows(row).Copy Wks.Rows(NextRow) وضع مكانه هذين السطرين Rng.Rows(row).Copy Wks.Rows(NextRow).PasteSpecial xlPasteValues لتحصل على القيم فقط لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي 1 رابط هذا التعليق شارك More sharing options...
المتأمل الحسني قام بنشر مايو 30, 2015 الكاتب مشاركة قام بنشر مايو 30, 2015 الله يرحم والديك .. رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 الله يرحم والديك .. الحمد لله الذي بنعمته تتم الصالحات مشكور على دعائك الطيب المبارك دعوة مرة أخرى أخي الكريم لتغيير اسم الظهور للغة العربية راجع الرابط التالي رابط التوجيهات رابط هذا التعليق شارك More sharing options...
المتأمل الحسني قام بنشر مايو 30, 2015 الكاتب مشاركة قام بنشر مايو 30, 2015 حاضر.. أبشر ... و قد غيرت الإسم إلى العربي... و العفو . رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر مايو 30, 2015 مشاركة قام بنشر مايو 30, 2015 بارك الله فيك أخي المتأمل .. وجزيت خيراً على تلبية طلبي تقبل تحياتي رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان