أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
EM_ACC مجدى يونس-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة بحاجة الى كود ترحيل اكسيل اسئله واجابات


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تكرار ورقة عمل

السلام عليكم الاستاذة الكرام...عملت كود ترحيل لورقة عمل لكن الغريب فى الامر ان الكود لا يستجيب للحدث ولا يظهر رسالة خطاء ..


موضوع مغلق


subject icon تمت الإجابة تكرار ورقة عمل
05-09-2021 09:41 صباحا
احمد شريف
عضو نشيط
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-10-2019
رقم العضوية : 15301
المشاركات : 85
الجنس : ذكر
تاريخ الميلاد : 5-2-1973
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 105
 offline 

السلام عليكم الاستاذة الكرام...عملت كود ترحيل لورقة عمل لكن الغريب فى الامر ان الكود لا يستجيب للحدث ولا يظهر رسالة خطاء اين تكمن المشكلة

ورقة العمل الذى اريد ترحيلها موجودة فى الشيت رقم 4 بعنوان 1-18 الكود

Sub copy_sheet()
Dim numberofcopies As Integer
numberofcopies = InputBox("How many sheets")
Dim copy As Integer
For copy = 1 To numbercopies
Sheets(4).copy after:=Sheets(4)
Next copy
End Sub

هذه هى المشكلة الاولى فى الترحيل اما المشكلة التانية كيفية الترحيل مع تغير اسماء الشيتات لتبدو بهذا لشكل

1 -18
2 -19
3 - 20 وهكذا مرفق لحضرتكم الملف
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
 


 
 
 
  ZS-1.xlsm   تحميل xlsm مرات التحميل :(4)
الحجم :(176.421) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
وعليكم السلام
جرب الكود بهذا الشكل
Sub Copy_Sheet()
    Dim ws As Worksheet, sName As String, num As Integer, i As Integer, x As Integer, y As Integer
    Set ws = ThisWorkbook.Worksheets(4)
    num = InputBox("How Many Sheets?")
    x = Val(Split(ws.Name, "-")(0))
    y = Val(Split(ws.Name, "-")(1))
    For i = 1 To Val(num)
        x = x + 1: y = y + 1
        sName = x & "-" & y
        If Evaluate("ISREF('" & sName & "'!A1)") Then GoTo Skipper
        ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        ActiveSheet.Name = sName
Skipper:
    Next i
End Sub
عرض الإجابة




05-09-2021 09:45 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10439
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 0
يتابعونه : 533
قوة السمعة : 36372
عدد الإجابات: 252
 offline 
look/images/icons/i1.gif تكرار ورقة عمل
وعليكم السلام
جرب الكود بهذا الشكل
Sub Copy_Sheet()
    Dim ws As Worksheet, sName As String, num As Integer, i As Integer, x As Integer, y As Integer
    Set ws = ThisWorkbook.Worksheets(4)
    num = InputBox("How Many Sheets?")
    x = Val(Split(ws.Name, "-")(0))
    y = Val(Split(ws.Name, "-")(1))
    For i = 1 To Val(num)
        x = x + 1: y = y + 1
        sName = x & "-" & y
        If Evaluate("ISREF('" & sName & "'!A1)") Then GoTo Skipper
        ws.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        ActiveSheet.Name = sName
Skipper:
    Next i
End Sub



الكلمات الدلالية
تكرار ، ورقة ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 09:35 صباحا