كيف اكرر كود الترحيل في جميع الاوراق ضيف جديد

[ياسر خليل أبو البراء]

الحل بسيط وهو أن تقوم بإضافة سطر قبل بداية الكود يقوم بفك حماية الورقة التي سيتم الترحيل إليها
وسطر آخر في نهاية الكود لإرجاع الحماية

يمكن استخدام Protect و Unprotect .. الموضوع سهل ويسير إن شاء الله

[ابومحمد2017]

استاذي الكريم 
ياسر خليل أبو البراء

ماهو السطر 

الذي يقوم بفك حماية الورقة 

امل كتابته لي 

جزاك الله خير 

[ياسر خليل أبو البراء]

تشير الى الورقة المطلوبة باستخدام كلمة Sheets يليها قوس مفتوح باستخدام شفت + رقم 9 من الأرقام التي فوق الحروف (ليس من الأرقام في لوحة الأرقام) ثم تفتح قوس " باستخدام شفت + حرف الطاء وتكتب اسم الورقة المراد فك حمايتها ثم تستخدم كلمة Unportect

مثال

Sheets("Sheet1").Unprotect

ثم مسافة ثم كلمة مرور فك الحماية 

وللحماية مرة أخرى ستستخدم نفس السطر مع استبدال كلمة Unprotect بكلمة Protect

[۩◊۩ أبو حنين ۩◊۩]

الاخ الكريم  عند كتابه الجواب  ... وجت رد الاستاذ الفاضل ياسر خليل

وهو خير معلم 

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

تم تعديل يناير 11, 2017 بواسطه ۩◊۩ أبو حنين ۩◊۩

[۩◊۩ أبو حنين ۩◊۩]

الاخ الكريم الكود هيكون بهذاالشكل

Sub TARHEEELL()
    Dim FS As Worksheet, TS As Worksheet
    Dim R, ER1, ER2
    
    Set TS = Sheets("data")
    Set FS = ActiveSheet
    ER2 = TS.Range("A55555").End(xlUp).Row + 1

    Application.ScreenUpdating = False
Sheets("data").Unprotect Password:="aaa"
        If FS.Name <> "data" Then
            For ER1 = 3 To FS.Cells(Rows.Count, 1).End(xlUp).Row
                If FS.Cells(ER1, 1) <> "" And FS.Cells(ER1, 14) <> "مرحل" Then
                    TS.Cells(ER2, 1).Resize(1, 13).Value = FS.Cells(ER1, 1).Resize(1, 13).Value
                    FS.Cells(ER1, 14) = "مرحل"
                    ER2 = ER2 + 1
                End If
            Next ER1
        End If
    Application.ScreenUpdating = True
Sheets("data").protect Password:="aaa"

End Sub