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

[أبو سجده]

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

وبه نستعين

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

أشكر حضراتكم لحسن تعاونكم مع جميع السادة الاعضاء

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

الطلب الاول إضافة كود كما هو موضح بصفحة " المصروفات "

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

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

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

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

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

إليك الطلب الأول .. عله يون المطلوب

وبارك الله فيك على التوضيح المفصل والذي يزيل أي لبس

Sub TransferData()
    Dim Ws As Worksheet, Sh As Worksheet, LR As Long
    
    Set Ws = Sheet2: Set Sh = Sheet5
    
    Application.ScreenUpdating = False
        Ws.Range("B8:C" & Ws.Cells(Rows.Count, "B").End(xlUp).Row).Copy
        LR = Sh.Cells(Rows.Count, "Q").End(xlUp).Row + 1
        Sh.Range("Q" & LR).PasteSpecial xlPasteValues
        Sh.Range("P" & LR).Value = Ws.Range("B6").Value
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

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

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

بصراحة الكود الذي تريد التعديل عليه كود معقد بعض الشيء وبطيء كما قلت ولا أدري ما الداعي لهذا التعقيد ..

حاولت تتبع أسطر الكود لأعرف ما هي المهمة التي يقوم بها (تعبتني وكان من الأفضل شرح المطلوب من الكود بدلاً من أن تعطيني كود وتقوله عدله ، فالتعديل في بعض الأحيان يكون أصعب من كتابة الكود نفسه خصوصاً إذا لم أكن من كتبت أسطر الكود)

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

إليك الكود الجديد للطلب الثاني

Sub TarhilModified()
    Dim Ws As Worksheet, Sh As Worksheet, LR As Long
    
    Set Ws = Sheet4: Set Sh = Sheet5
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        LR = Sh.Cells(Rows.Count, "L").End(xlUp).Row + 1
        
        With Ws
            .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            
            .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("L" & LR).PasteSpecial xlPasteValues
            
            .Range("I8:J" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("M" & LR).PasteSpecial xlPasteValues
            
            .Cells.EntireRow.Hidden = False
            Sh.Range("I" & LR).Resize(1, 3).Value = Array(Ws.Range("M4").Value, Ws.Range("M2").Value, Ws.Range("B4").Value)
            
            Sh.Activate
        End With
    
    Application.CutCopyMode = False
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

[أبو سجده]

أخى العزيز الغالى // ابو البراء

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

أعلم أن الكود المشار اليه بالمرفق السابق معقد بعض الشيىء

فضلا عن ثقله فى التنفيذ حيث يستغرق وقتا فى تنفيذه

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

 يقين بالله تعالى

أنه سيُقتلع من جذوره واستبداله بكود أخر يتميز بالمرونة والسرعة

أسعدك الله فى الدارين **** وأحسن الله تعالى اليكم كما أحسنت الينا

بقى أخر جزء فى الموضوع وهو يتعلق

بطباعة التقاريرعن حركة الصادر والوارد 

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

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

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

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

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

أخي وحبيبي سعيد

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

أما بالنسبة لتخصيص طلب لكل موضوع ، هذا يجعل الموضوع يشارك فيه جميع الأعضاء بشكل أكثر فعالية (أرجو ألا يكون الأمر مزعج لكم)

تقبل وافر تقديري واحترامي

[أبو سجده]

الان, ياسر خليل أبو البراء said:

و هذا يجعل الموضوع يشارك فيه جميع الأعضاء بشكل أكثر فعالية

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

احلى صباح عليك وعلى عيونك

 بارك الله فيك  **** ورزقنا الله واياكم من حيث لانحتسب

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

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

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

صباح الخيرات حبيبي في الله سعيد

أسعدك الله في الدارين وإن شاء الله لكل نصيب من اسمه

وجزيت خيراً بمثل ما دعوت لي

 

[أبو سجده]

اللهم امين

اللهم امين

اللهم امين

دعواتك ابوالبراء

[أبو سجده]

هل ياترى هناك مفاجأئة بانتظارى 

بشأن طباعة التقاريرالخاصة بحركة الفواتير الصادره والوارده والمصروفات

إن كان الامر كذلك **** فالامر عائد لك أخى ابو البراء

 بس حاجة كدة على ذوقك ***** وان كان حلما

يبقى مافيش فايدة ونرفع موضوع وأمرى لله

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

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

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

صدقني أقصد المصلحة من طرح موضوع جديد ، وليس الإعاقة كما تظن وقد شرحت لك وجهة نظري

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

[أبو سجده]

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

السلام عليكم 

عذرا أخى الحبيب

برجاء الاطلاع على المرفق التالى نظرا لوجود

تعديل طفيف كما هو موضح بالمرفق

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

ترحيل الفواتير الصادرة والمصروفات+555.rar

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

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

المفروض الحاجات الصغيرة دي منتكلمش فيها

الفكرة ببساطة إني بعتمد زي ما قلت لك على إخفاء الصفوف .. ونسخ الظاهر فقط من الخلايا.. وطالما أنك تريد إخفاء العمود J يبقا الموضوع أبسط مما تتخيل

في بداية الكود نظهر العمود J وننسخ ونرحل المطلوب وفي الآخر نخفيه

شفت بسيطة إزاي : شالو كلب مقطقط حطوا قطة مكلبة

 

إليك الكود بعد التعديل البسيط

Sub TarhilModified()
    Dim Ws As Worksheet, Sh As Worksheet, LR As Long
    
    Set Ws = Sheet4: Set Sh = Sheet5
    
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        LR = Sh.Cells(Rows.Count, "L").End(xlUp).Row + 1
        
        With Ws
            .Columns("D:J").Hidden = False
            .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row + 1).SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
            
            .Range("C8:C" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("L" & LR).PasteSpecial xlPasteValues
            
            .Range("I8:J" & .Cells(Rows.Count, "C").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
            Sh.Range("M" & LR).PasteSpecial xlPasteValues
            
            .Cells.EntireRow.Hidden = False
            Sh.Range("I" & LR).Resize(1, 3).Value = Array(Ws.Range("M4").Value, Ws.Range("M2").Value, Ws.Range("B4").Value)
            
            .Columns("D:H").Hidden = True: .Columns("J:J").Hidden = True
            Sh.Activate
        End With
    
    Application.CutCopyMode = False
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

[أبو سجده]

هههههههههههههههه

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

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

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