كود ترحيل بيانات بشرط .. ولا أسهل

عبدالله الداعري · مايو 26, 2014

طيب االله اوقاتكم

عبدالله الداعري · مايو 26, 2014

تكرموا :

شيت الاوائل 10 :signthankspin:

**ا بو سليمان** · مايو 27, 2014

احسنت واحسن الله اليك

shathafpa@hotmail.com · أغسطس 14, 2015

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

ياسر خليل أبو البراء · أغسطس 14, 2015

أخي الكريم محمود

أهلاً بك ومرحباُ بين إخوانك .. وشرفت المنتدى

عادةً لا يلتفت إلى الطلبات في المشاركات الفرعية

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

ابن بنها · مارس 30, 2016

ربنا يبارك في النافع

ابوذر · يوليو 19, 2016

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

اريد مساعد عجلة منكم جزاكم الله كل خير

رغم تحميل مختف الاكود و التعديل عليها لم انجح في تعديل

اريد ان يعمل الملف على النحو التالي:

نقل جميع بيانات التلاميذ الناجحين حسب قرار المجلس او النتيجة الى شيت جديد باسم ممنوح و نقل جميع بيانات الراسبين حسب قرار المجلس او النتيجة الى شيت تجميد

وشكر

جدول تصفية المنح.rar

الشربيني123 · يوليو 25, 2016

استاذي الفاضل / محمدي

اولا جزاك الله كل خيرعما قمت به من شروحات ..

ثانيا : يعني ايه معيار انا استخدمت كودك في اللي اتظبط معايا وتمام وفيه اللي مطلع عيني ..ممكن شرح ( معيار R 61 ) و COPY 1.73من فضلك

مرسل الشيت ... وطلب اخر معلش اسف للاطالة لماذا بيتم الجمع مع خانات قيمتها أقل من ربع الدرجة من المفروض لا تجمع

مثل الصف 14 مادة القرآن الكريم سوف تجد عمود L اقل من الربع وعمود M أقل من الربع ...ومع ذلك تم جمعهما مع عمودي J ; K

هل من حل او دالة تجمع بشرط ان يكون الخانة هذه والخانة هذه تساوي او اكبر من ربع الدرجة ؟ مرفق الملف

تحيااااااااتي لك ولكل المنتدى ...بجد كلكم ذووووق واحترام

تصميم شيت 12.rar

**ناصر سعيد** · ديسمبر 7, 2016

ترحيل عن طريق القائمه المنسدله للعلامه عبد الله باقشير

Sub الديانة()
On Error Resume Next
H = Range("دين").Value
LastRow_1 = Cells(Rows.Count, "B").End(xlUp).Row + 8
Range("B8:AS" & LastRow_1).ClearContents
With Sheets("الصف الخامس")
S = 8
LastRow_2 = .Cells(.Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
For QQ = 12 To LastRow_2
       If .Cells(QQ, 3).Value = H Then
          .Cells(QQ, 2).Range("A1:AS1").Copy
           Cells(S, 2).PasteSpecial Paste:=xlPasteValues
           S = S + 1
      End If
Next
End With
Application.CutCopyMode = True
LastRow_3 = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$B$1:$AV$" & LastRow_3
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
Application.GoTo [AX4]
On Error GoTo 0
End Sub
Sub ناجح()
On Error Resume Next
H = "ناجح"
LastRow_1 = Cells(Rows.Count, "B").End(xlUp).Row + 8
Range("B8:AS" & LastRow_1).ClearContents
With Sheets("الصف الخامس")
S = 8
LastRow_2 = .Cells(.Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
For QQ = 12 To LastRow_2
       If .Cells(QQ, 47).Value = H Then
          .Cells(QQ, 2).Range("A1:AS1").Copy
           Cells(S, 2).PasteSpecial Paste:=xlPasteValues
           S = S + 1
      End If
Next
End With
Application.CutCopyMode = True
LastRow_3 = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$B$1:$AV$" & LastRow_3
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
Application.GoTo [A1]
On Error GoTo 0
End Sub
Sub دور_تاني()
On Error Resume Next
H = "دور ثان"
LastRow_1 = Cells(Rows.Count, "B").End(xlUp).Row + 8
Range("B8:AV" & LastRow_1).ClearContents
With Sheets("الصف الخامس")
S = 8
LastRow_2 = .Cells(.Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
For QQ = 12 To LastRow_2
       If .Cells(QQ, 47).Value = H Then
          .Cells(QQ, 2).Range("A1:AV1").Copy
           Cells(S, 2).PasteSpecial Paste:=xlPasteValues
           S = S + 1
      End If
Next
End With
Application.CutCopyMode = True
LastRow_3 = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$B$1:$AW$" & LastRow_3
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
Application.GoTo [A1]
On Error GoTo 0
End Sub
Sub راسب()
On Error Resume Next
H = "راسب"
LastRow_1 = Cells(Rows.Count, "B").End(xlUp).Row + 8
Range("B8:BA" & LastRow_1).ClearContents
With Sheets("الصف الخامس")
S = 8
LastRow_2 = .Cells(.Rows.Count, "E").End(xlUp).Row
Application.ScreenUpdating = False
For QQ = 12 To LastRow_2
       If .Cells(QQ, 47).Value = H Then
          .Cells(QQ, 2).Range("A1:AZ1").Copy
           Cells(S, 2).PasteSpecial Paste:=xlPasteValues
           S = S + 1
      End If
Next
End With
Application.CutCopyMode = True
LastRow_3 = Cells(Rows.Count, "B").End(xlUp).Row
ActiveSheet.PageSetup.PrintArea = "$B$1:$BB$" & LastRow_3
ActiveWindow.SelectedSheets.PrintPreview
Application.ScreenUpdating = True
Application.GoTo [A1]
On Error GoTo 0
End Sub

ترحيل عن طريق القائمة المنسدله.rar

za.wlid14 · ديسمبر 7, 2016

بارك الله في جهودكم ونفعنا الله واياكم .. وبعلمكم نتقدم ان شاء الله وجعله الله في ميزان حسناتكم

**ناصر سعيد** · ديسمبر 11, 2016

ترحيل او استدعاء رائع


'''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Sub NAGEH()
''هذا الكود للعبقري ياسر العربي حفظه الله
'' تم هذا الكود بتاريخ 8 / 10/ 2016
''الهدف من الكود هو استدعاء بيانات
''شرح الكود
''
    Dim myArray, lr, X, targt, targt1, targt2, targtN
    Dim SERCH As Worksheet, DATA As Worksheet
    '____________________________________________
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت  المصدر
    Set SERCH = Worksheets("كشف ناجح")    'اسم الشيت الهدف
    '____________________________________________
    Range("A8:R1000").Clear
    'النطاقات متغيره
    Range("B7:R7").AutoFill Destination:=Range("B7:R" & Range("A4").Value + 6), Type:=xlFillDefault
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2  'اخر صف به بيانات
    'رقم عمود البدايه اللي بعد المسلسل
  '  متغير
    SERCH.Range("C7:N" & SERCH.Cells(Rows.Count, 3).End(xlUp).Row + 1).ClearContents    'مسح نطاق البحث القديم
    targt = "له* دور ثان في"    'معيار البحث
    
     'نطاق قاعدةالبيانات المصدر الذي سيتم البحث فيه
    myArray = DATA.Range("A7:EF" & lr)
    '____________________________________________
    'عدد الاعمده في الجدول في صفحه الهدف
    ReDim Y(1 To lr, 1 To 13)
    For X = 1 To lr - 6
        If targt = "" Then Exit Sub
        
        'رقم عمود معيار البحث
        If myArray(X, 101) Like targt & "*" Then
            rw = rw + 1
            'For ww = 1 To 102
              '  Y(rw, ww) = myArray(X, ww)
          '  Next ww
    'العمود التاني بعد المسلسل
          Y(rw, 1) = myArray(X, 2)
          
              'العمود الثالث بعد المسلسل
          Y(rw, 2) = myArray(X, 3)
          
              'العمود الرابع بعد المسلسل
          Y(rw, 3) = myArray(X, 13)
          
              'العمود الخامس بعد المسلسل
          Y(rw, 4) = myArray(X, 22)
          
              'العمود السادس بعد المسلسل وهكذا
          Y(rw, 5) = myArray(X, 31)
          
          Y(rw, 6) = myArray(X, 40)
          Y(rw, 7) = myArray(X, 51)
          Y(rw, 8) = myArray(X, 52)
          Y(rw, 9) = myArray(X, 82)
          Y(rw, 10) = myArray(X, 101)
          Y(rw, 11) = myArray(X, 102)
        '  Y(rw, 12) = myArray(X, 110)
         ' Y(rw, 13) = myArray(X, 111)
        End If
Next X
If rw > 0 Then SERCH.Cells(Rows.Count, 3).End(xlUp)(2, 1).Resize(rw, 13).Value = Y()
End Sub

ترحيل الدور التاني5.rar

**ا بو سليمان** · ديسمبر 12, 2016

باااااااااااااااارك الله فيكم جميعا

**ناصر سعيد** · ديسمبر 12, 2016

11 ساعات مضت, ناصر سعيد said:

ترحيل او استدعاء رائع



'''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''
Sub NAGEH()
''هذا الكود للعبقري ياسر العربي حفظه الله
'' تم هذا الكود بتاريخ 8 / 10/ 2016
''الهدف من الكود هو استدعاء بيانات
''شرح الكود
''
    Dim myArray, lr, X, targt, targt1, targt2, targtN
    Dim SERCH As Worksheet, DATA As Worksheet
    '____________________________________________
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت  المصدر
    Set SERCH = Worksheets("كشف ناجح")    'اسم الشيت الهدف
    '____________________________________________
    Range("A8:R1000").Clear
    'النطاقات متغيره
    Range("B7:R7").AutoFill Destination:=Range("B7:R" & Range("A4").Value + 6), Type:=xlFillDefault
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row + 2  'اخر صف به بيانات
    'رقم عمود البدايه اللي بعد المسلسل
  '  متغير
    SERCH.Range("C7:N" & SERCH.Cells(Rows.Count, 3).End(xlUp).Row + 1).ClearContents    'مسح نطاق البحث القديم
    targt = "له* دور ثان في"    'معيار البحث
    
     'نطاق قاعدةالبيانات المصدر الذي سيتم البحث فيه
    myArray = DATA.Range("A7:EF" & lr)
    '____________________________________________
    'عدد الاعمده في الجدول في صفحه الهدف
    ReDim Y(1 To lr, 1 To 13)
    For X = 1 To lr - 6
        If targt = "" Then Exit Sub
        
        'رقم عمود معيار البحث
        If myArray(X, 101) Like targt & "*" Then
            rw = rw + 1
            'For ww = 1 To 102
              '  Y(rw, ww) = myArray(X, ww)
          '  Next ww
    'العمود التاني بعد المسلسل
          Y(rw, 1) = myArray(X, 2)
          
              'العمود الثالث بعد المسلسل
          Y(rw, 2) = myArray(X, 3)
          
              'العمود الرابع بعد المسلسل
          Y(rw, 3) = myArray(X, 13)
          
              'العمود الخامس بعد المسلسل
          Y(rw, 4) = myArray(X, 22)
          
              'العمود السادس بعد المسلسل وهكذا
          Y(rw, 5) = myArray(X, 31)
          
          Y(rw, 6) = myArray(X, 40)
          Y(rw, 7) = myArray(X, 51)
          Y(rw, 8) = myArray(X, 52)
          Y(rw, 9) = myArray(X, 82)
          Y(rw, 10) = myArray(X, 101)
          Y(rw, 11) = myArray(X, 102)
        '  Y(rw, 12) = myArray(X, 110)
         ' Y(rw, 13) = myArray(X, 111)
        End If
Next X
If rw > 0 Then SERCH.Cells(Rows.Count, 3).End(xlUp)(2, 1).Resize(rw, 13).Value = Y()
End Sub

ترحيل الدور التاني5.rar

ربنا يبارك في النافع

**ناصر سعيد** · نوفمبر 20, 2017

Nizar abd AlRawashdeh · مارس 29, 2018

السلام عليكم بارك الله فيكم على إدارة المنتدى والتفاعل المميز ...

كود رائع وتم تطبيقه وأموره تمام لكن أريد تعديل على الكود بحيث الصفوف التي تم ترحيلها تحذف من الشيت الأصلي لها وشكراً

ملاحظة : عدلت الكود وتم حذف الصفوف التي بالمصدر ولكن عند التنفيذ مرة أخرى يتم حذفها من الشيت الآخر الذي تم إليه الترحيل

lerby-7 · أكتوبر 18, 2018

شكرااااااااااااا لك اااااااااااااااااخي

weka2010 · ديسمبر 27, 2018

السلام عليكم عاوز اعمل كود او دلة يرحل البيانات من خط السير للخطوط السير الاسبوعى والشهريه

وياريت لو اعرف اثبت ارقام للمستشفيات

حركة السيارات.xlsx

عادل سليم · مارس 1, 2019

السلام عليكم

كل الشكر والتقدير على المعلومه ونفعكم الله بعلمه

تم التفيذ وكان اسهل بكثير مما عندى

كان يطلب دالة الناجح فى المقدمه والا يدرج اول تلميذ سواء كان راسب او ناجح

ولكن مع هذا الكود الكل تمام واشكرك

اخيك عادل محفوظ عبدالعليم سليم / المنيا / ديرمواس / دلجا / رئيس قطاع دلجا التعليمى

ومرسل لك العمل للتقييم

ترحيل ناجح وراسب.xls

تم تعديل مارس 1, 2019 بواسطه عادل سليم

هشام جودي · أبريل 10, 2019

السلام عليكم

الملف يطلب اسم المستخدم و كلمة السر

تسجيل الدخول

كود ترحيل بيانات بشرط .. ولا أسهل

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

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

Important Information