استخراج الأسماء من صفحات متعددة وترحيلها في صفحة واحدة

[ابوخليل]

اخوتي الاكارم

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

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

المطلوب : 

بضغطة زر اريد ترحيل الاسماء العربية فقط وارقام المعرفات من الصفحات وضمها في صفحة جديدة واحدة 

بيانات طلاب.rar

[عبدالله باقشير]

وعليكم السلام ورحمة الله وبركاته
 
ما رايك لو يضيف لك الاسماء في ملف جديد
ولك الخيار في حفظه من عدمه

Sub Macro1()
Dim wo1 As Workbook, wo2 As Workbook
Dim sh As Worksheet
Dim r As Long, i As Long, lr As Long
Set wo1 = ThisWorkbook
Set wo2 = Workbooks.Add
i = 2
For Each sh In wo1.Sheets
    With sh
    lr = .Cells(.Rows.Count, "p").End(xlUp).Row
        For r = 17 To lr Step 2
            wo2.Sheets(1).Cells(i, "a").Value = .Cells(r, "w").Value
            wo2.Sheets(1).Cells(i, "b").Value = .Cells(r, "p").Value
            i = i + 1
        Next
    End With
Next
Set wo1 = Nothing: Set wo2 = Nothing
End Sub

اذا تريده في نفس الملف برضه ممكن
ولكن في كل ضغطة زر سيضيف صفحة جديدة وستتعدد الاوراق في الملف
 
تحياتي

[دغيدى]

السلام عليكم

كود ما اجمل وما أخف

وفقكم الله

[ابوخليل]

ما رايك لو يضيف لك الاسماء في ملف جديد

 

 

 هو ما اريده بالضبط 

وسؤالي كان للتسهيل والتيسير

   

    سلمت أناملك استاذنا الكريم والف شكر لهذا الحل الرائع

                         أحاطك الله بلطفه وعنايته

                                          وبارك لك في وقتك ومالك

                                                               وأصلح لك في ذريتك