علي المصري

شكرا جزيلا

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

الكود التالي لنقل الاعمدة الموضح بالرقام من صفحة الى اخرى Sub Cycles() Dim a With Sheets("DataT1").Cells(1).CurrentRegion a = .Value With Sheets("CyclesT1") .Cells(1, 1).Resize(UBound(a), 31) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), [{1,2,4,6,7,8,9,10,11,12,13,14,15,16,17}]) End With: End With End Sub قمت بالتعديل على ارقام الاعمدة التي يراد نقلها كما هو موضح بالكود التالي Sub CyclesB1T1() Dim a With Sheets("B1DataT1").Cells(1).CurrentRegion a = .Value With Sheets("CyB1T1") .Cells(1, 1).Resize(UBound(a), 15) = Application.Index(a, Evaluate("row(1:" & UBound(a) & ")"), [{20,21,23,25,26,27,28,29,30,31,32,33,34,35,36}]) End With: End With End Sub مما ادى الى ظهور #REF عند التنفيذ ما الخطأ T1.xlsb

شكرا جزيلا وجزاكم الله خيرا ومعذرة على تعبكم

بعد عملية الترحيل اريد ترحيل بعض الاعمدة من هذه البيانات المجمعة في الصفحة DataT1 إلى صفحة جديدة اخرى اسمها مثلا GradesT1 فكيف يكون شكل الكود شكرا لكم

عند استخدام هذا الكود ظهر صف فارغ بين بيانات الصفة الاولى والثانية وهكذا تم التغلب عليه عن طريق التعديل التالي Sub Merge_Sheets() Dim Sht As Worksheet Dim Sht6 As Worksheet Dim LastRow6 As Long Dim Rng As Range Set Sht6 = Sheets("DataT1") 'Determine lastrow on DatatT1 x = Array("B1DataT1", "B2DataT1", "B3DataT1") 'Loop though B1DataT1 - B2DataT1 - B3DataT1 For i = 0 To UBound(x) Set Sht = Sheets(x(i)) 'Find last row LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Set Range Set Rng = Sht.Range("A3:Q" & LastRow) LastRow6 = Sht6.Cells(Rows.Count, 1).End(xlUp).Row 'Copy to DataT1 If LastRow6 = 1 Then Rng.Copy Destination:=Sht6.Range("A" & LastRow6 + 2) Else Rng.Copy Destination:=Sht6.Range("A" & LastRow6 + 1) End If Next End Sub مع الشكر الجزيل لحضرتك

أولا شكرا لك وجزاك الله خيرا ثانيا ممكن شرح لهذا السطر من الكود

لا يعطي نتيجة

السلام عليكم ورحمة الله وبركاته الكود التالي المفروض يقوم بدمج الصفحات الثلاثة B3DataT1, B2DataT1, B1DataT1 الي الصفحة DataT1 ولكن لا يعمل بشكل صحيح فهل من مساعدة لتصحيحه Sub Merge_Sheets() Dim Sht As Worksheet Dim Sht6 As Worksheet Dim LastRow6 As Long Dim Rng As Range Set Sht6 = Sheets("DataT1") 'Determine lastrow on DatatT1 LastRow6 = Sht6.Range("A" & Rows.Count).End(xlUp).Row 'Loop though B1DataT1 - B2DataT1 - B3DataT1 For Each Sht In Sheets(Array("B1DataT1", "B2DataT1", "B3DataT1")) 'Find last row LastRow = Sht.Range("A" & Rows.Count).End(xlUp).Row 'Set Range Set Rng = Sht.Range("A3:Q" & LastRow) 'Copy to DataT1 Rng.Copy Destination:=Sht6.Range("A3:Q" & LastRow6 + 2) Next End Sub T1 --Data.xlsb

تم تعديل الكود الى frmMyUserForm.Show vbModeless DoEvents --- --- --- --- Unload frmMyUserForm واصبح كل شي تمام الحمد لله

السلام عليكم ورحمة الله وبركاته اردت ان اظهر فورم اثناء عمل كود بحيث تظهر الفورم منذ بداية تنفيذ الكود وتختفي عند انتهاء الكود فاستخدمت هذا الكود frmMyUserForm.Show vbModeless --- --- --- --- Unload frmMyUserForm ولكن تظهر لي الفورم فارغة والكود بعمل ما فيه مشكلة فما الحل

شكرا جزيلا

تم التوصل للحل عن طريق اضافة .Net Framework 3.5 اذا امكن كود لا يعتمد على هذه