hassan rady قام بنشر أغسطس 11, 2020 مشاركة قام بنشر أغسطس 11, 2020 السلام عليكم ورحمة الله وبركاته في المرفق ملف تجريبي لبيانات طلاب المطلوب كود ينشأ صفحة باسم كل فصل مع ترحيل البيانات انا ابغى الكود عشان اطبقه على اي بيانات بنفس الفكرة اذا امكن شكرا لكم TEST.xlsb.xlsx رابط هذا التعليق شارك More sharing options...
أفضل إجابة سليم حاصبيا قام بنشر أغسطس 11, 2020 أفضل إجابة مشاركة قام بنشر أغسطس 11, 2020 جرب هذا الكود Option Explicit Dim sh As Worksheet Dim Other_sh As Worksheet Dim Rg As Range Dim All_RG As Range Dim lc%, i%, Ro%, Arr(), itm '+++++++++++++++++++++++ Sub creat_shett() Set sh = Sheets("Sheet1") lc = sh.Cells(Rows.Count, 3).End(3).Row For Each Rg In sh.Range("C2:C" & lc) If Rg.Value <> "" Then If Not Application.Evaluate("ISREF('" & Rg.Value & "'!A1)") Then sh.Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Rg.Value End If End If Next add_data End Sub Sub add_data() Set sh = Sheets("Sheet1") For Each Other_sh In Sheets If Other_sh.Name <> "Sheet1" Then ReDim Preserve Arr(i) Arr(i) = Other_sh.Name i = i + 1 End If Next For Each itm In Arr Set Other_sh = Sheets(itm) With Other_sh Set All_RG = .Range("A1").CurrentRegion Ro = All_RG.Rows.Count If Ro > 1 Then Set All_RG = All_RG.Offset(1).Resize(Ro - 1) All_RG.Clear End If .Range("Z1") = sh.Cells(1, 3) .Range("Z2") = .Name sh.Range("A1").CurrentRegion.AdvancedFilter 2, _ .Range("Z1:Z2"), .Range("A1:d1") .Range("Z1:Z2").Clear End With Next End Sub الملف مرفق Hasan_rady.xlsm 4 رابط هذا التعليق شارك More sharing options...
hassan rady قام بنشر أغسطس 12, 2020 الكاتب مشاركة قام بنشر أغسطس 12, 2020 @سليم حاصبيا ممكن تحدد المتغيرات في الكود حتى اقدر استخدمه على شيتات ثانية رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أغسطس 14, 2020 مشاركة قام بنشر أغسطس 14, 2020 كل ما هو سطر Dim يكون متغير رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.