ترحيل الاصناف الفعلية من الواردات والصادرات

[أبو سجده]

بسم الله الرحمن الرحيم

وبه نستعين

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

المرفق التالى يوضح المطلوب

صفحة الفواتير الواردة

المطلوب بإذن الله تعالى ترحيل الاصناف الواردة فعليا قرين كل صنف بصفحة " القائمة العامة للمخازن "

تعديل الكود الاول Tarhil 

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

 ليصبح الترحيل ترحيلا مزدوجا وفى أن واحد

من صفحة الفواتير الواردة الى صفحتى " القائمة الرئيسية للمخازن + حركة الصادر والوراد "

هذا هو الجزء الاول من المطلوب

 تقبلوا وافر تقديرى واحترامى *** وجزاكم الله خيرا

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

تم تعديل يناير 18, 2016 بواسطه سعيد بيرم

[ياسر خليل أبو البراء]

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

أخي الحبيب سعيد

والله أنا مش عارف بتوه ليه في كلامك .. حاول تكون أكثر تحديداً لأني تايه في الملف (لأنك أدرى بالملف مني)

نمسك موضوع الترحيل واحدة واحدة ..أقولك تقول ايه عشان تلاقي استجابة ..

قول الورقة المسماة كذا في النطاق كذا إلى آخر النطا كذا ..المطلوب ترحيله إلى ورقة كذا وتكون بداية البيانات المرحلة الخلية كذا ... أو ترفق شكل النتائج المتوقعة ..

امسك جزئية جزئية عشان تلاقي استجابة أسرع وإلا سينفذ منك الوقت ولن تجد استجابة

أرجو ألا يكون كلامي مصدر إزعاج لك ...

كل ما في الأمر أنني لا أفهم طبيعة عملك وهذا ما يشوش الأفكار .. ويجعلني محتار .. ربنا يجيرك من حر النار

تقبل تحياتي

 

[أبو سجده]

أخى الحبيب ياسر 

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

مزيدا من التوضيح والتفصيل

معلوم ان لكل شركة مُصنعة عدد محدد من الاصناف التى تقوم بإنتاجها

ومن المعلوم  أيضا أنه ليس شرطا أساسيا ان تطلب كتاجر أو موزع جميع ماتنتجه تلك الشركة كلما تم الطلب

وربما تطلب عدد معين من الاصناف اوربما جميعها حسب الاحوال " بس قول يارب **** وحسن السوق ولا حسن البضاعة " 

المطلوب بإذن الله تعالى فى هذا الجزء من المطلوب

اولا ترحيل محتويات الفواتير الواردة من العمود B و حتى العمود D بداية من الخلية B8  

الى  صفحة " القائمة العامة للمخازن " على أن يتم ترحيل الاصناف الواردة قرين كل صنف  " بدلالة أسم الصنف " 

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

ثانيا بشأن الكود التالى 

 

Sub Tarhil()
    Dim Ws As Worksheet, Sh As Worksheet
    Dim LRWS As Long, LRSH As Long
    Dim X As Long, I As Long
    Set Ws = Sheets("الفواتيرالواردة"): Set Sh = Sheets("حركة الصادر والوارد والمصروفات")
    LRWS = Ws.Cells(39, 1).End(xlUp).Row
    X = Application.WorksheetFunction.CountA(Ws.Range("A8:A" & LRWS))
    Application.ScreenUpdating = False
        For I = 1 To X
            LRSH = Sh.Cells(Rows.Count, 2).End(xlUp).Row + 1
            Sh.Cells(LRSH, 2).Value = Ws.Range("b6")
            Sh.Cells(LRSH, 3).Value = Ws.Range("c3")
            Sh.Cells(LRSH, 4).Value = Ws.Cells(7 + I, 2).Value
            Sh.Cells(LRSH, 5).Value = Ws.Cells(7 + I, 3).Value
            Sh.Cells(LRSH, 6).Value = Ws.Cells(7 + I, 4).Value
        Next I
    MsgBox "الترحيل لصفحة حركة الوارد والصادروالمصروفات", vbInformation, "YasserKhalil"
    Application.ScreenUpdating = True
End Sub

فهو يعمل على ترحيل الفواتير الواردة الى صفحة " حركة الصادر والوارد "

ولكن هناك تعديلا من شأنه ترحيل محتويات الفوتير الورادة

مع تجاهل الصفوف التى ليس بها كميات واردة مع مراعة ذكر أسم الشركة مرة واحدة وكذا تاريخ ورود الفاتورة

وافر تقديرى واحترامى ***** وجزاكم الله خيرا

ترحيل الاصناف الفعلية من الواردات والصادرات+111.rar

تم تعديل يناير 18, 2016 بواسطه سعيد بيرم

[ياسر خليل أبو البراء]

أخي الكريم سعيد

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

خلينا في نقطة واحدة عشان نقدر نخطو خطوة للأمام

سيبك من لغة التفاهم الغير مفهومة بالنسبة لي على الإطلاق ..

سأخبرك ما فهمت للآن وأنت أكد لي ما هو صحيح أو صوب ما هو خطأ

الورقة المراد الترحيل منها هي ورقة العمل المسماة "الفواتير الواردة"

النطاق الذي سيتم الترحيل منه هو B8:D37 على أن ترحل الصفوف الغير فارغة في عمود الكميو والسعر .. أي يتم ترحيل الصفوف 9 - 10 - 11 - 14 - 16 -17 وهكذاا

الورقة المراد الترحيل إليها هي ورقة العمل المسماة "القائمة العامة للمخازن" وأول خلية ترحل البيانات إليها هي أول خلية فارغة في العمود الثاني العمود B

الأعمدة التي سيتم الترحيل إليها هي B و C و D فقط ..

أرجو التأكيد أو التصحيح لما فهمت

[أبو سجده]

اخى الحبيب //  ياسر ابو البراء

نعم هو كذلك

وافر تقديرى واحترامى

تم تعديل يناير 18, 2016 بواسطه سعيد بيرم

[ياسر خليل أبو البراء]

أخي الكريم سعيد بيرم

جرب الكود التالي عله يفي بالغرض إن شاء الله

Sub TransferData()
    Dim WS As Worksheet, SH As Worksheet
    Dim Area As Range, Rg As Range, Rng As Range
    
    Set WS = Sheet1: Set SH = Sheet3
    
    Application.ScreenUpdating = False
        For Each Area In WS.Range("B8:D" & WS.Cells(Rows.Count, "B").End(xlUp).Row).SpecialCells(2).Areas
            Set Rg = Area.Offset(, -1).Resize(Area.Rows.Count, 3)
            If Rng Is Nothing Then Set Rng = Rg Else Set Rng = Union(Rng, Rg)
        Next Area
        
        Rng.Copy
        SH.Range("B" & SH.Cells(Rows.Count, "B").End(xlUp).Row).Offset(1).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

[أبو سجده]

اخى الحبيب المحترم // ابو البراء

السلام عليكم 

بداية بارك الله فيكم لصبركم و إصراركم على مساعدتى فى هذا الموضوع

بشأن صفحة " القائمة العامة للمخازن " العمود B   الخاص بالاصناف 

هذة الاصناف ثايته والمطلوب التعديل

ليتم ترحيل الكمية الواردة وسعر الشراء بدلالة اسم الصنف ايا كان موقعه

تقبل وافر احترامى مع قبول اعتذارى لهذا الخطأ الغير مقصود 

جزاكم الله خيرا

 

[ياسر خليل أبو البراء]

أخي الحبيب سعيد

تصر على شرح المطلوب بما تفهمه أنت وليس بما أفهمه أنا ...

لم أفهم جملتك أن يتم الترحيل للكمية الواردة وسعر الشراء بدلالة الصنف أياً كان موقعه ..حدد موقعه فين ؟؟ لا أدري أين هي تلك المواقع ؟؟ ربما تكون المواقع في مناطق نائية في السلوم أو حلايب وشلاتيت أو في العين السخنة ..!!

أخبرتك أني أريد تحديد الخلايا واوراق العمل المطلوبة ..

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

تقبل تحياتي

[ياسر خليل أبو البراء]

أخي الغالي سعيد

يبدو أنني قد فهمت المطلوب بعد الإمعان في الملف المرفق

إليك الكود التالي عله يكون المطلوب ... رغم أنني لا أحبذ العمل على الاحتمالات بس إن شاء الله يكون المطلوب

Sub TransferMatchingData()
    Dim WS As Worksheet, SH As Worksheet
    Dim Cel As Range, Found As Range
    
    Set WS = Sheet1: Set SH = Sheet3
    
    Application.ScreenUpdating = False
        On Error Resume Next
        For Each Cel In WS.Range("B8:B" & WS.Cells(Rows.Count, "B").End(xlUp).Row)
            Set Found = SH.Range("B:B").Find(What:=Cel.Value, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
            
            If Not Found Is Nothing And Not IsEmpty(Cel.Value) Then
                Found.Offset(, 1).Resize(1, 2).Value = Cel.Offset(, 1).Resize(1, 2).Value
            End If
            
        Next Cel
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

[أبو سجده]

اخى الخلوق المحترم // ابو البراء

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

نعم حبيب قلبى لقد أدركت المطلوب تماما

 

نأتى بحول الله تعالى ومن بعد إذنك  للجزء الثانى من المطلوب 

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

وهو من احد روائعك " يعنى مبجبشى حاجة من عندى "

حيث يرحل الكود من صفحة " الفواتير الواردة " الى صفحة " حركة الوارد والصادر " دون مشاكل

وحسب ما أريد ولكن يحتاج الكود الى بعض التعديلات المبينه من داخل المرفق 

 برجاء الاطلاع والافادة بإذن الله تعالى

بارك الله فيكم وفى البراء **** تقبل وافر احترامى وتقديرى **** وجزاكم الله خيرا

ترحيل الاصناف الفعلية من الواردات والصادرات+333.rar

[ياسر خليل أبو البراء]

أخي العزيز سعيد بيرم

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

الحمد لله أن تم المطلوب الأول على خير .. وإن كنت أفضل التعامل مع الطلبات كل طلب في موضوع منفصل ، لكني سأقوم بعمل استثناء لك ..!! رغم أنه ليس من المفضل لدي العمل على أكثر من طلب في موضوع واحد

إليك الكود التالي عله يكون المطلوب

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

إليك الكود

Sub TransferDataUsingFilterMethod()
    Dim WS As Worksheet, SH As Worksheet
    Dim LR As Long, LastRow As Long
    Dim X As Long, I As Long
    
    Set WS = Sheet1: Set SH = Sheet5
    LR = WS.Cells(Rows.Count, 1).End(xlUp).Row
    LastRow = SH.Cells(Rows.Count, "D").End(xlUp).Row + 1
    
    Application.ScreenUpdating = False
        With WS
            .AutoFilterMode = False
            .Range("A7:D7").AutoFilter Field:=3, Criteria1:="<>" & ""
            
            .Range("B8:D" & LR).SpecialCells(xlCellTypeVisible).Copy
            SH.Cells(LastRow, "D").PasteSpecial xlPasteValues
            
            SH.Cells(LastRow, "B").Value = WS.Range("B6").Value
            SH.Cells(LastRow, "C").Value = WS.Range("C3").Value
            
            .AutoFilterMode = False
        End With
    
        Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "Done...", vbInformation, "YasserKhalil"
End Sub

تقبل تحياتي

 

[أبو سجده]

اخى الحبيب الغالى جدا جدا  // ابو البراء

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

والحمد لله تعالى تم المطلوب الثانى على خير

  

بارك الله فيك والله العظيم انا مش عارف من غيرك كنت عملت ايه

أطمع فى إستثنائين فقط ويكتمل الموضوع

منها تعديلا فى كود

واضافة كود أخر

وإن لم يكن فسيتم رفع موضوع بهما

مساءا إن قدرالله تعالى لى البقاء

الله أسأل أن يعطيك ويعطينا بقدرنياتنا الخالصة لوجه الله الكريم

وافر تقديرى واحترامى حبيب قلبى **** وجزاكم الله خيرا

 

تم تعديل يناير 20, 2016 بواسطه سعيد بيرم

[ياسر خليل أبو البراء]

أخي الحبيب سعيد بيرم

الحمد لله أن تم المطلوب الثاني على خير

الرجاء طرح موضوع جديد بطلبك الجديد ليشارك فيه الجميع حيث أن الاستجابة تكون أفضل مع الموضوعات الجديدة

وبالنسبة لي سأكون غير متاح بعد قليل ...

وجزاكم الله خيراً على دعواتك الطيبة المباركة

تقبل تحياتي

[أبو سجده]

اخى الحبيب الغالى // ابو البراء

على الرحب والسعة

جارى اعداد ملف سيتم رفعه مساءا بحول الله تعالى

وجزاكم الله خيرا