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

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
mmagedmemo ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil هل يمكن تغيير مسار الصورة فى الحفظ ونقلها للمسار الجديد اكسيل اسئله واجابات


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





مطلوب كود ترحيل

السلام عليكم ورحمة الله الرجاء من الاخوة الافاضل المساعدة في عمل كود ترحيل من الشيت sh1 الى الشيت sh2 مع تثبيت قيم معي ..


موضوع مغلق


subject icon تمت الإجابة مطلوب كود ترحيل
06-09-2020 10:08 مساء
elabassy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 06-09-2020
رقم العضوية : 20302
المشاركات : 15
الجنس : ذكر
تاريخ الميلاد : 1-5-1973
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 28
 offline 

 السلام عليكم ورحمة الله
الرجاء من الاخوة الافاضل المساعدة في عمل كود ترحيل من الشيت sh1
الى الشيت sh2 
مع تثبيت قيم معينة في كل صف مرحل ومرفق ملف به الوان لتوضيح الخلايا المطلوب ترحيلها

 
 
 
  test.rar   تحميل rar مرات التحميل :(4)
الحجم :(9.198) KB



أفضل إجابة مقدمة من YasserKhalil وهي:
وعليكم السلام أخي الكريم
أهلا بك في المنتدى ، ونورت بين إخوانك
يرجى فيما بعد أن تظهر لنا محاولاتك في سبيل الوصول للحل ، فالمنتدى تعليمي وليس خدمي
جرب الكود التالي عله يكون المطلوب إن شاء العلي القدير
Sub Test()
    Dim ws As Worksheet, sh As Worksheet, m As Long, r As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("Sh1")
        Set sh = ThisWorkbook.Worksheets("Sh2")
        m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
        For r = 15 To 20
            If ws.Cells(r, 1).Value <> "" Then
                sh.Range("A" & m).Resize(1, 10).Value = Array(ws.Cells(r, 1).Value, ws.Cells(r, 3).Value, ws.Cells(r, 6).Value, ws.Range("D4").Value, ws.Range("H4").Value, ws.Range("H10").Value, ws.Cells(r, 10).Value, ws.Cells(r, 12).Value, ws.Range("D12").Value, ws.Range("C34").Value)
                m = m + 1
            End If
        Next r
    Application.ScreenUpdating = True
End Sub
عرض الإجابة




06-09-2020 10:28 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10461
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 539
قوة السمعة : 36712
عدد الإجابات: 257
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل
وعليكم السلام أخي الكريم
أهلا بك في المنتدى ، ونورت بين إخوانك
يرجى فيما بعد أن تظهر لنا محاولاتك في سبيل الوصول للحل ، فالمنتدى تعليمي وليس خدمي
جرب الكود التالي عله يكون المطلوب إن شاء العلي القدير
Sub Test()
    Dim ws As Worksheet, sh As Worksheet, m As Long, r As Long
    Application.ScreenUpdating = False
        Set ws = ThisWorkbook.Worksheets("Sh1")
        Set sh = ThisWorkbook.Worksheets("Sh2")
        m = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1
        For r = 15 To 20
            If ws.Cells(r, 1).Value <> "" Then
                sh.Range("A" & m).Resize(1, 10).Value = Array(ws.Cells(r, 1).Value, ws.Cells(r, 3).Value, ws.Cells(r, 6).Value, ws.Range("D4").Value, ws.Range("H4").Value, ws.Range("H10").Value, ws.Cells(r, 10).Value, ws.Cells(r, 12).Value, ws.Range("D12").Value, ws.Range("C34").Value)
                m = m + 1
            End If
        Next r
    Application.ScreenUpdating = True
End Sub

06-09-2020 10:41 مساء
مشاهدة مشاركة منفردة [2]
elabassy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 06-09-2020
رقم العضوية : 20302
المشاركات : 15
الجنس : ذكر
تاريخ الميلاد : 1-5-1973
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 28
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل
استاذي الفاضل 
اشكرك اولا على الرد الراقي
ولكني محاولاتي كلها لا ترتقي لعرضها 
وسوف اخذ هذا في اعتباري فيما بعد
ولك جزيل الشكر

 

06-09-2020 10:43 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10461
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 539
قوة السمعة : 36712
عدد الإجابات: 257
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل
مهما كانت محاولاتك لابد أن تؤخذ في الاعتبار ، حتى لو كانت مجرد فكرة ، وفي المنتدى نتكامل معاً للوصول لأفضل فكرة ولأفضل حل وهذا هو الهدف من المنتدى.

06-09-2020 10:54 مساء
مشاهدة مشاركة منفردة [4]
elabassy
عضو
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 06-09-2020
رقم العضوية : 20302
المشاركات : 15
الجنس : ذكر
تاريخ الميلاد : 1-5-1973
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 28
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل
جزاكم الله خيرا استاذنا الفاضل  YasserKhalil

07-09-2020 09:37 صباحا
مشاهدة مشاركة منفردة [5]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10461
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 539
قوة السمعة : 36712
عدد الإجابات: 257
 offline 
look/images/icons/i1.gif مطلوب كود ترحيل
وجزيت خيراً أخي الكريم بمثل ما دعوت لي وزيادة والحمد لله أن تم المطلوب على خير.
والحمد لله الذي بنعمته تتم الصالحات.



الكلمات الدلالية
مطلوب ، ترحيل ،


 










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

الساعة الآن 02:21 صباحا