ياريت تساعدوني في كود الترحيل لهذا الملف

[عبدالناصر محمود]

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

alex star.rar

[عبد العزيز البسكري]

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

أخي الكريم عبد الناصر محمود لا تظن أنّي نسيتك .. فقط كنت أراجع في الملف .. ولم أكمل العمل عليه بعدُ ..على كل حال هذه محاولة بسيطة أتمنى أن تفي بالغرض في انتظار ملاحظاتك و أي تقصير أو تعديل ..فجميع الأساتذة الكرام لن يبخلوا عليك بمساعداتهم .

                                                                                                                خالص احتراماتي

 

عبد الناصر محمود 3.rar

[إبراهيم ابوليله]

اخى عبد العزيز

كود جميل ورائع

بارك الله فيك

تقبل تحياتى

اخى عبد الناصر

هذا كود اخر

يفى بالمطلوب

Sub trs_invoice()
Application.ScreenUpdating = False
Dim LR As Long, LR1 As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("ÝÇÊæÑÉ ÈíÚ")
Set WS1 = Worksheets("ÊÑÍíá ÇáÝÇÊæÑÉ")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
Dim FR
       For R = 3 To LR1
        If WS1.Cells(R, 3) = WS.Range("f6") Then MsgBox "This invoice already exist, No shift will done": Exit Sub
    Next
For FR = 11 To 27
If WS.Cells(FR, 2) = "" Then GoTo 7
WS1.Cells(LR1, 2) = WS.Range("F7").Value
WS1.Cells(LR1, 3) = WS.Range("F6").Value
WS1.Cells(LR1, 4) = WS.Range("C6").Value
WS1.Cells(LR1, 5) = WS.Range("C7").Value


WS.Range("B" & FR & ":H" & FR).Copy
WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
LR1 = LR1 + 1
7 Next FR
Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
End Sub

تقبل تحياتى

تم تعديل سبتمبر 29, 2015 بواسطه إبراهيم ابوليله

[عبدالناصر محمود]

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

[عبدالناصر محمود]

ارجو من حضراتكم طريقة يتم من خلالها طرح الكمية المطلوبة من الكمية المتاحة بعد ترحيل الفاتورة بحيث يكون الفاتورة اثرت في عمود الكمية المتاحة

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

[إبراهيم ابوليله]

اخى عبد الناصر

جرب الكود الاتى

وهذا على حسب فهمى للمطلوب

...............................................

اذا لم يفى الكود بالمطلوب

يرجى وضع مرفق

به مثال لما تريد

Sub trs_invoice()
Application.ScreenUpdating = False
Dim LR As Long, LR1 As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("فاتورة بيع")
Set WS1 = Worksheets("ترحيل الفاتورة")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
Dim FR
       For R = 3 To LR1
        If WS1.Cells(R, 3) = WS.Range("f6") Then MsgBox "This invoice already exist, No shift will done": Exit Sub
    Next
For FR = 11 To 27
If WS.Cells(FR, 2) = "" Then GoTo 7
WS1.Cells(LR1, 2) = WS.Range("F7").Value
WS1.Cells(LR1, 3) = WS.Range("F6").Value
WS1.Cells(LR1, 4) = WS.Range("C6").Value
WS1.Cells(LR1, 5) = WS.Range("C7").Value


WS.Range("B" & FR & ":H" & FR).Copy
WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS1.Range("M" & LR1).Value = WS1.Range("H" & LR1) - WS1.Range("L" & LR1)

LR1 = LR1 + 1
7 Next FR
Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
End Sub

تقبل تحياتى

تم تعديل سبتمبر 29, 2015 بواسطه إبراهيم ابوليله

[عبدالناصر محمود]

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

عملت فاتورة رقم 5 مثلا وتم بيع عدد10 كالون جولد . وتم ترحيل الفاتورة ولحد هنا تمام
المطلوب ان ال 10 كالون يتم طرحهم من عمود الكمية المتبقية  في صفحة الاصناف بحيث يكون صنف كالون جولد بعد الترحيل الباقي منة 35 وليس 45 كما هو بالرصيد في صفحه الاصناف  

[إبراهيم ابوليله]

اخى عبد الناصر

ارجو ارفاق ملف

به مثال لما تريد تيسيرا على الاخوه الاضاء فى مساعدتك

تقبل تحياتى

تم تعديل سبتمبر 30, 2015 بواسطه إبراهيم ابوليله

[عبد العزيز البسكري]

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

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

فقط لو سمحت أستاذي الغالي .. و لو توفّر لديك الوقت .. تنظر في ملفي هذا الخاص بنفس عمليّة الترحيل فقط تراعي تغيير أماكن الأعمدة ..العمود الأصفر في فاتورة بيع يُرحَّل إلى العمود الأصفر في الشيت ترحيل الفاتورة.. الأخضر يُرحَّل إلى العمود الخضر .. إلخ .. أو إذا كانت لديك أي فكرة أخرى عن الترحيل لكن مع مراعاة تغيير أماكن الأعمدة

                                                              ألف شكر مقدّمًا .. خالص احتراماتي

 

عبد الناصر محمود 4.rar

[عبدالناصر محمود]

انا عملت كومنت في صفحة فاتورة بيع وكومنت اخر في صفحة الاصناف بالمطلوب ونرجوا المتابعة

alex star 2.rar

[إبراهيم ابوليله]

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

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

فقط لو سمحت أستاذي الغالي .. و لو توفّر لديك الوقت .. تنظر في ملفي هذا الخاص بنفس عمليّة الترحيل فقط تراعي تغيير أماكن الأعمدة ..العمود الأصفر في فاتورة بيع يُرحَّل إلى العمود الأصفر في الشيت ترحيل الفاتورة.. الأخضر يُرحَّل إلى العمود الخضر .. إلخ .. أو إذا كانت لديك أي فكرة أخرى عن الترحيل لكن مع مراعاة تغيير أماكن الأعمدة

                                                              ألف شكر مقدّمًا .. خالص احتراماتي

 

عبد الناصر محمود 4.rar

اخى عبد العزيز

ان تقصد ان الترحيل هيكون مرتبطر باللون

يعنى مثلا

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

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

وهكذا

 

[عبد العزيز البسكري]

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

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

                                                                                           خالص احتراماتي

 

الترحيل.rar

[إبراهيم ابوليله]

انا عملت كومنت في صفحة فاتورة بيع وكومنت اخر في صفحة الاصناف بالمطلوب ونرجوا المتابعة

alex star 2.rar

انا مش فاهم

ارقم 45جبته منين

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

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

                                                                                           خالص احتراماتي

 

الترحيل.rar

اخى عبد العزيز

هل تقصد هكذا

Sub trs_invoice()
Application.ScreenUpdating = False
Dim LR As Long, LR1 As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS = Worksheets("فاتورة بيع")
Set WS1 = Worksheets("ترحيل الفاتورة")
LR1 = WS1.Range("c55555").End(xlUp).Row + 1
Dim FR
       For R = 3 To LR1
        If WS1.Cells(R, 3) = WS.Range("f6") Then MsgBox "This invoice already exist, No shift will done": Exit Sub
    Next
For FR = 11 To 27
If WS.Cells(FR, 2) = "" Then GoTo 7
WS1.Cells(LR1, 2) = WS.Range("F7").Value
WS1.Cells(LR1, 3) = WS.Range("F6").Value
WS1.Cells(LR1, 4) = WS.Range("C6").Value
WS1.Cells(LR1, 5) = WS.Range("C7").Value
WS.Range("B" & FR & ":H" & FR).Copy

WS.Range("h" & FR & ":H" & FR).Copy
WS1.Range("F" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("g" & FR & ":g" & FR).Copy
WS1.Range("g" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("f" & FR & ":f" & FR).Copy
WS1.Range("h" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("e" & FR & ":e" & FR).Copy
WS1.Range("i" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("d" & FR & ":d" & FR).Copy
WS1.Range("j" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("c" & FR & ":c" & FR).Copy
WS1.Range("k" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
WS.Range("b" & FR & ":b" & FR).Copy
WS1.Range("l" & LR1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

LR1 = LR1 + 1
7 Next FR
Application.CutCopyMode = False
WS.Select
Application.ScreenUpdating = True
End Sub

تقبل تحياتى

تم تعديل أكتوبر 1, 2015 بواسطه إبراهيم ابوليله

[إبراهيم ابوليله]

اخى عبد العزيز

جرب ايضا الكود الاتى

Sub hima_trs2()
Dim LR As Long
Dim LR1 As Long
Dim WS As Worksheet
Dim WS1 As Worksheet
Set WS1 = Worksheets("ترحيل الفاتورة")
Set WS = Worksheets("فاتورة بيع")
If WorksheetFunction.CountIf(WS1.[C3:C10000], WS.[f6]) <> 0 Then MsgBox "This invoice already exist, No shift will done": Exit Sub
LR1 = WS.Range("a11").End(xlDown).Row
With WS.Range("a11:h" & Cells(Rows.Count, "a").End(xlUp).Row)
    If .Row = 11 Then
        LR = WS1.Cells(Rows.Count, "B").End(xlUp).Row + 1
       WS1.Cells(LR, "B").Resize(.Rows.Count, 1).Value = WS.[f7]
        WS1.Cells(LR, "C").Resize(.Rows.Count, 1).Value = WS.[f6]
         WS1.Cells(LR, "D").Resize(.Rows.Count, 1).Value = WS.[c6]
           WS1.Cells(LR, "e").Resize(.Rows.Count, 1).Value = WS.[c7]
       
              WS1.Cells(LR, "f").Resize(.Rows.Count, 1).Value = WS.Range("h11:H" & LR1).Value
               WS1.Cells(LR, "g").Resize(.Rows.Count, 1).Value = WS.Range("g11:g" & LR1).Value
                WS1.Cells(LR, "h").Resize(.Rows.Count, 1).Value = WS.Range("f11:f" & LR1).Value
                 WS1.Cells(LR, "i").Resize(.Rows.Count, 1).Value = WS.Range("e11:e" & LR1).Value
                  WS1.Cells(LR, "j").Resize(.Rows.Count, 1).Value = WS.Range("d11:d" & LR1).Value
                   WS1.Cells(LR, "k").Resize(.Rows.Count, 1).Value = WS.Range("c11:c" & LR1).Value
                    WS1.Cells(LR, "l").Resize(.Rows.Count, 1).Value = WS.Range("b11:b" & LR1).Value
                  End If
End With
End Sub

تقبل تحياتى

تم تعديل أكتوبر 1, 2015 بواسطه إبراهيم ابوليله

[عبدالناصر محمود]

استاذ ابراهيم الرقم 45 دا رصيد الصنف اقصد المخزون

تم تعديل أكتوبر 1, 2015 بواسطه عبدالناصر محمود

[عبد العزيز البسكري]

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

الله الله عليك أستاذنا القدير ابراهيم أبو ليله .. ماشاء الله تبارك الله

هذا ما أريده بالضبط .. بالتّمام و الكمال .. ألف ألف شكر .. كلّه على بعضهْ الكود الأول أو الثاني شغّال تمامًا مثلما تمنّيت .

بارك الله فيك و جزاك الله خيرًا .. وزادك من علمه و فضله

                                                                                                 خالص احتراماتي

 

تم تعديل أكتوبر 1, 2015 بواسطه عبد العزيز البسكري

[إبراهيم ابوليله]

استاذ ابراهيم الرقم 45 دا رصيد الصنف اقصد المخزون

الرصيد ده اجيبو منين

[عبدالناصر محمود]

استاذ ابراهيم الرقم 45 دا رصيد الصنف اقصد المخزون

الرصيد ده اجيبو منين

انا عملت تعديل بسيط ف صفحه الاصناف وعملت عمود اسمه الرصيد اول بحيث نشتغل عليه

alex star 3.rar

[عبدالناصر محمود]

alex star 2.rar