اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ما الخطأ في هذا الكود ؟


2saad

الردود الموصى بها

خبراء المندي الكرام
عندي شيت به ورقتين
في الورقة الأولي المسماة (  ملف وتحريري نصف العام صف خامس ) عند الضغط علي زر الترحيل الي الورقة الثانية المسماة ( شيت صف خامس )
يرحل اليبانات اعلي الصف 14
وانا اريد الترحيل ابتداء من الصف 14
فما الخطأ في هذا الكود ؟
وشكرا لكم 

https://www.mediafire.com/file/lfz7z4rb1s63eb9/سها.xlsm/file

رابط هذا التعليق
شارك

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

استخدم هذا الكود اسرع و افضل

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

 

  • Like 2
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information