كيف انسخ هذا الشيت (بكل تنسيقاته) إلى ملف آخر باستخدام الكود

[ياسر أحمد الشيخ]

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

عندى شيت به تنسيقات كثيره جدا

عندما أقوم بنسخه لملف آخر تتغير الألوان والخطوط تصبخ غير مقروءة

كيف انسخ هذا الشيت (بكل تنسيقاته) إلى ملف آخر باستخدام الكود

الملف الآخر باسم مثلا Book1

أرجو الافادة

System.rar

[الـعيدروس]

السلام عليكم

جرب هذا الكود

Sub A_Copy()

Dim W As Workbook

Set W = Workbooks.Add(xlWorksheet)

ThisWorkbook.Sheets(1).Copy W.Sheets(1)

End Sub

[ياسر أحمد الشيخ]

السلام عليكم

شكرا أخى على الرد

ولكن هذا الحل لم يجدى نفعا

جرب أخى على الملف وأرفقلى الملف بالحل مرة أخرى

لاحظ أخى اننى اريد نسخ الشيت بكل تنسيقاته الشرطية

شكرا

[ياسر أحمد الشيخ]

للرفع

أرجو الاهتمام أيها الأخوة

[الـعيدروس]

جربت الكود نسخ كل شيء التنسيقات الشرطية موجوده في الملف الجديد ؟

تم تعديل ديسمبر 19, 2012 بواسطه عباد

[ياسر أحمد الشيخ]

شكرا أخى للاهتمام

ولكن تبقى المشكلة

لاحظ أخى الصفوف 11،12،13 و 21،22،23 وهكذا

النصوص غير مرئية بها

ما الحل أخى الكريم

[الـعيدروس]

السلام عليكم

بعد استخدام الكود

انسخ هذا الكود في الملف الجديد

وشغله إن شاء الله تزبط معك الألوان

Public Sub Ali_Form()

Dim R As Range, Rn As Range

Dim Ct As FormatCondition

With ActiveSheet

Set R = .Range("A1:J102").SpecialCells(xlCellTypeAllFormatConditions)

With Application

  .ScreenUpdating = False: .EnableEvents = False

For Each Rn In R

For C = 1 To Rn.FormatConditions.Count

Set Ct = Rn.FormatConditions(C)

If Ct.Interior.ColorIndex Then

Ct.Interior.Color = 14474738

End If

Next

Next

  .ScreenUpdating = True: .EnableEvents = True

End With

End With

End Sub

[احمد حبيبه]

أستاذى أبو نصار لى سؤال بسيط لو عندى شيت مكون من 100 صفحة عمل واريد نسخ جميع الصفحات بتنسيقاتهم ومعادلاتهم واكوادهم لشيت جديد فهل هذا ممكن ولو ممكن ممكن تزودنى بهذا الكود الهام جدا وطريقة إستخدامه

[الـعيدروس]

السلام عليكم

جرب هذا الكود

Public Sub Ali_Copy()

    Dim Sh As Worksheet

    Dim W1 As Workbook

    Set W1 = ThisWorkbook

    Dim W As Workbook

    Set W = Workbooks.Add(xlWorksheet)

With Application

    .ScreenUpdating = False

    .EnableEvents = False

    .Calculation = xlCalculationManual

    W.Sheets(1).Name = "Test"

    .DisplayAlerts = False

    For Each Sh In W1.Sheets

	    Sh.Copy After:=W.Sheets(W.Sheets.Count)

    Next Sh

    W.Sheets(1).Delete

    .ScreenUpdating = True

    .EnableEvents = True

    .Calculation = xlCalculationAutomatic

    .DisplayAlerts = True

End With

End Sub

[احمد حبيبه]

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

[ابو تميم]

ما شاء الله أستاذ ابو نصار

روائع

الله يحميك

[إبراهيم محمد]

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

زادك الله علما و نورا

[احمد فضيله]

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