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

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
مالك ماريه ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil 2-طلب تحويل الكود من الحلقه التكراريه for الى array اكسيل اسئله واجابات


اعلان هنا
ألعاب فلاش أون لاين
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



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





تعديل كود الترحيل

السلام عليكم احتاج الى تعديل الكود الشرح داخل الملف



23-05-2019 11:46 صباحا
المبتدأ
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 183
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 132
الاعجاب : 43
 offline 

السلام عليكم  
احتاج الى تعديل الكود 
الشرح داخل الملف 
 
 
  ترحيل فاتورة‫‬.rar   تحميل rar مرات التحميل :(9)
الحجم :(19.655) KB







23-05-2019 01:01 مساء
مشاهدة مشاركة منفردة [1]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 7794
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 418
قوة السمعة : 22535
الاعجاب : 2010
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
وعليكم السلام
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim sh As Worksheet
Dim m As Long
Dim r As Long

Application.ScreenUpdating = False
Set ws = ThisWorkbook.Worksheets(1)
Set sh = ThisWorkbook.Worksheets(2)
m = sh.Cells(Rows.Count, 1).End(xlUp).Row
If sh.Cells(m, 1) <> "" Then m = m + 1

r = ws.Cells(10, 1).End(xlUp).Row
If r < 3 Then Exit Sub

ws.Range("A3:E" & r).Copy sh.Range("A" & m)
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

أثارت هذه المشاركة إعجاب: ali mohamed ali، Eslam Abdullah،




23-05-2019 01:44 مساء
مشاهدة مشاركة منفردة [2]
المبتدأ
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 183
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 132
الاعجاب : 43
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
شكرا اخي على الكود ولكن تبقى خانة الاجمالي  لم تظهر  

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




23-05-2019 02:22 مساء
مشاهدة مشاركة منفردة [3]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 7794
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 418
قوة السمعة : 22535
الاعجاب : 2010
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
راجع الكود وتأكد من آخر عمود يتم الترحيل منه

أثارت هذه المشاركة إعجاب: ali mohamed ali، Eslam Abdullah،




23-05-2019 02:33 مساء
مشاهدة مشاركة منفردة [4]
المبتدأ
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 183
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 132
الاعجاب : 43
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
لقد تاكدت آخر عمود هو E  لايوجد خطا في تحديد مدى الخلايا 

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




23-05-2019 03:24 مساء
مشاهدة مشاركة منفردة [5]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 7794
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 418
قوة السمعة : 22535
الاعجاب : 2010
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
يتم الترحيل معي لآخر عمود بدون مشاكل .. هلا أرفقت صورة بالمشكلة؟

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




23-05-2019 07:41 مساء
مشاهدة مشاركة منفردة [6]
المبتدأ
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 183
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 132
الاعجاب : 43
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
انا ما قصدته صف الاجمالي  ارفق لك صورةانا ما قصدته صف الاجمالي  ارفق لك صورة

Dub9a_PIC
 
 


أثارت هذه المشاركة إعجاب: Eslam Abdullah،




23-05-2019 09:12 مساء
مشاهدة مشاركة منفردة [7]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 409
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 17
قوة السمعة : 3285
الاعجاب : 237
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
لعد اذن اخيالحبيب ياسر وتكملة للكود الذي قام مشكوراً بانشاءه

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim sh As Worksheet
Dim m As Long
Dim r As Long

Application.ScreenUpdating = False
Set ws = Sheets("ادخال البيانات ")
Set sh = Sheets("ورقة2")
m = sh.Cells(Rows.Count, "e").End(xlUp).Row + 1
If sh.Cells(m, 1) <> "" Then m = m + 1

r = ws.Cells(10, 1).End(xlUp).Row
If r < 3 Then Exit Sub

sh.Cells(m, 1).Resize(r - 2, 5).Value = _
ws.Range("A3").Resize(r - 2, 5).Value
sh.Cells(m + r - 2, 5).Formula = _
"=SUM(E" & m & ":E" & m + r - 3 & ")"
sh.Cells(m + r - 2, 2) = "المجموع"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub




أثارت هذه المشاركة إعجاب: ali mohamed ali، YasserKhalil،




23-05-2019 09:19 مساء
مشاهدة مشاركة منفردة [8]
المبتدأ
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 183
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 132
الاعجاب : 43
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
اخي سالم  شكرا على الكود يعمل  ولكن ليس ككود الاخ ياسر  لاني اردت الترحيل بنفس التنسيق الموجود في ورقة ادخال البيانات  يمكنك الاطلاع على المرفقات التي قمت بالرد على الاخ ياسر 





23-05-2019 09:58 مساء
مشاهدة مشاركة منفردة [9]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 409
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 17
قوة السمعة : 3285
الاعجاب : 237
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
اذا اردت نسخ التنسيق  ايضاً
هذا الكود

Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim sh As Worksheet
Dim m As Long
Dim r As Long

Application.ScreenUpdating = False
Set ws = Sheets("ادخال البيانات ")
Set sh = Sheets("ورقة2")
m = sh.Cells(Rows.Count, "e").End(xlUp).Row + 1
If sh.Cells(m, 1) <> "" Then m = m + 1

r = ws.Cells(10, 1).End(xlUp).Row
If r < 3 Then Exit Sub
ws.Range("A3").Resize(r - 1, 5).Copy _
sh.Cells(m, 1)
sh.Cells(m + r - 2, 5).Formula = _
"=SUM(E" & m & ":E" & m + r - 3 & ")"
sh.Cells(m + r - 2, 2) = "المجموع"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


الملف مرفق

 
 
  trahil_Fatoura.rar   تحميل rar مرات التحميل :(8)
الحجم :(22.377) KB


أثارت هذه المشاركة إعجاب: YasserKhalil، عبدالله فتحى،




23-05-2019 10:12 مساء
مشاهدة مشاركة منفردة [10]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 7794
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 418
قوة السمعة : 22535
الاعجاب : 2010
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
بارك الله فيك أخي الحبيب سليم وجزيت خيراً





23-05-2019 10:49 مساء
مشاهدة مشاركة منفردة [11]
المبتدأ
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 28-01-2018
رقم العضوية : 4055
المشاركات : 183
الجنس : ذكر
تاريخ الميلاد : 17-8-1981
يتابعهم : 0
يتابعونه : 0
قوة السمعة : 132
الاعجاب : 43
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
اخي سليم شكرا لك الكود شغال 100% ولكن  عندي استفسار بسيط  وهو اريد نسخ الخانات ر.م , البيان , الكمية، والسعر , والاجمالي  كيف يمكن اعدل الكود 





23-05-2019 10:59 مساء
مشاهدة مشاركة منفردة [12]
ابراهيم الحداد
menu_open
خبير
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-08-2017
رقم العضوية : 163
المشاركات : 151
الجنس : ذكر
الدعوات : 1
يتابعهم : 0
يتابعونه : 25
قوة السمعة : 1292
الاعجاب : 29
 offline 
look/images/icons/i1.gif تعديل كود الترحيل
السلام عليكم 
جرب هذا الكود بشرط الا يتم زيادة صفوف الفاتورة عن التصميم المرفق بالملف
Private Sub CommandButton1_Click()
On Error Resume Next
Dim LR As Integer, i As Integer
If Range("a3") = "" Or Range("b3") = "" Or Range("C3") = "" Or Range("D3") = "" Or Range("E3") = "" = 1 Then
MsgBox "الرجاء اكمال البيانات"
Else
LR = ورقة2.Range("e1000").End(xlUp).Row + 1
ورقة1.Range("a2:e20").Copy
With ورقة2
.Cells(LR + 1, 1).PasteSpecial Paste:=xlPasteAll
For i = LR + 8 To LR + 4 Step -1
If .Cells(i, "B") = Empty Then
.Cells(i, "B").EntireRow.Delete
End If
Next
End With
MsgBox "تم بنجاح", vbDefaultButton1, "كود ترحيل البيانات- مرحبا بكم"
Sheets("ادخال البيانات").Select
Range("a3:D12").Select
Selection.ClearContents
End If
End Sub

أثارت هذه المشاركة إعجاب: Eslam Abdullah، YasserKhalil، عبدالله فتحى،





المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
تعديل الكود ليتم حفظ الصوة باسم الخلية مع تاريخ اليوم  ابوعلي الحبيب
8 52 ابوعلي الحبيب
مطلوب تعديل على الكود صلاح الصغير
3 34 YasserKhalil
تعديل كود تخزين الفاتورة على هيئة pdf المبتدأ
9 36 YasserKhalil
تعديل معادلة لاستخراج حساب (محطة) باستثناء بعض الارقام محمد لؤي
1 28 محمد لؤي
تعديل بكود بحث الليست بوكس للصفحة الأولى Fadel
4 73 Fadel

الكلمات الدلالية
الترحيل ، تعديل ،


 







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



الساعة الآن 05:19 صباحا

أعلن هنا
أعلن هنا
أعلن هنا