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

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

قام بنشر

خبراء المندي الكرام
عندي شيت به ورقتين
في الورقة الأولي المسماة (  ملف وتحريري نصف العام صف خامس ) عند الضغط علي زر الترحيل الي الورقة الثانية المسماة ( شيت صف خامس )
يرحل اليبانات اعلي الصف 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