2saad قام بنشر ديسمبر 3, 2021 قام بنشر ديسمبر 3, 2021 خبراء المندي الكرام عندي شيت به ورقتين في الورقة الأولي المسماة ( ملف وتحريري نصف العام صف خامس ) عند الضغط علي زر الترحيل الي الورقة الثانية المسماة ( شيت صف خامس ) يرحل اليبانات اعلي الصف 14 وانا اريد الترحيل ابتداء من الصف 14 فما الخطأ في هذا الكود ؟ وشكرا لكم https://www.mediafire.com/file/lfz7z4rb1s63eb9/سها.xlsm/file
ابراهيم الحداد قام بنشر ديسمبر 3, 2021 قام بنشر ديسمبر 3, 2021 السلام عليكم ورحمة الله استخدم هذا الكود اسرع و افضل Sub الصف_الخامس() Dim LR As Long, erow As Integer, sh28 As Worksheet, sh22 As Worksheet, i As Long Dim Arr As Variant, Tmp As Variant, p As Long t = Timer Application.ScreenUpdating = False Set sh28 = Worksheets(" ملف وتحريري نصف العام صف خامس") Set sh22 = Worksheets("شيت صف خامس") sh22.Range("B14:CZ1000").ClearContents LR = sh28.Cells(Rows.Count, 2).End(xlUp).Row Arr = sh28.Range("B14:EE" & LR).Value ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2)) For i = 1 To UBound(Arr, 1) If Arr(i, 1) <> Empty Then p = p + 1 For j = 1 To 32 Tmp(p, Choose(j, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 26, 36, _ 46, 48, 58, 83, 87, 91, 95, 99, 103, 17, 27, 37, 47, 59, 104)) = Arr(i, _ Choose(j, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 116, 117, 118, 119, _ 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133)) 'Tmp(p, 1) = p Next End If Next If p > 0 Then sh22.Range("B14").Resize(p, UBound(Tmp, 2)).Value = Tmp Application.ScreenUpdating = True 'MsgBox Round(Timer - t, 2) End Sub 2
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.