فاتوره مبيعات وشيت مخازن

[moh200cc]

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

انا امتلك نموذج بسيط ع الاكسل اريد بعض التعديلات 

 هو عباره عن فاتوره مبيعات وشيت مخازن يوجد فيه اسعار تجارى واسعار مستهلك 

هل يمكن عند اختيار من الفاتوره من القائمه المنسداله مبيعات تجارى او مبيعات تجزئه يتم تغير السعر

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

واريد عمل كشف حساب عميل ايضا 

ولكم منى جزيل الشكر 

مرفق نموذج العمل

 

 

gedyana.xlsm

[أحمد يوسف]

اهلا بك اخى الكريم بالمنتدى 

كيف تقوم برفع ملف محمى بكلمة سر

كما ان الطلبات كثيرة جدا -يجب عليك مراعاة أوقات الأساتذة حتى تتمكن من مساعدة من يحتاج الى مساعدة مثلك

[moh200cc]

اسف 

الباسورد 

admin

2105028

1 minute ago, أحمد يوسف said:

اهلا بك اخى الكريم بالمنتدى 

كيف تقوم برفع ملف محمى بكلمة سر

كما ان الطلبات كثيرة جدا -يجب عليك مراعاة أوقات الأساتذة حتى تتمكن من مساعدة من يحتاج الى مساعدة مثلك

اسف استاذ احمد

[Ali Mohamed Ali]

اعتذر من حضرتك أستاذ محمد لضيق الوقت فقد تم عمل الطلب الأول

تفضل

 

gedyana.xlsm

[moh200cc]

Just now, ali mohamed ali said:

اعتذر من حضرتك أستاذ محمد لضيق الوقت فقد تم عمل الطلب الأول

تفضل

 

gedyana.xlsm 518.82 kB · 0 downloads

شكرا استاذ على 

[moh200cc]

20 minutes ago, ali mohamed ali said:

 

 

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

[moh200cc]

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

[Ali Mohamed Ali]

تم التعديل على المديول رقم 2 ليصبح بهذا الشكل

Sub Macro1()
 Dim Arr
        With Sheets("Sheet1")
        Arr = Array(.Range("g2"), .Range("C1"), .Range("E1"), .Range("E3"), .Range("C3"), .Range("H21"), .Range("H22"), .Range("H23"))
    End With
        With Sheets("íæãíå ÇáãÈíÚÇÊ")
        .Range("B" & .Cells(Rows.Count, "B").End(xlUp).Row + 1).Resize(1, UBound(Arr) + 1).Value = Arr
    End With
        MsgBox "Done...", 64
    Range("C6").Select
    ActiveWindow.SmallScroll Down:=-3
    Range("g2").Select
    Sheets("Sheet1").Select
    Sheets("Sheet1").Copy After:=Sheets(1)
    Sheets("Sheet1 (2)").Select
    Sheets("Sheet1 (2)").Name = "Sheet1 (2)"
    Sheets("Sheet1 (2)").Select
    Sheets("Sheet1 (2)").Name = Range("g2").Value
    Range("B11").Select
    ActiveWindow.SmallScroll Down:=-3
    Sheets("Sheet1").Select
    ActiveWindow.SmallScroll Down:=0
    Range("c5:f20").Select
    Selection.ClearContents
    Range("C3").Select
    Selection.ClearContents
    ActiveWindow.SmallScroll Down:=-18
    Range("g2").Select
    Selection.Copy
    Range("I9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("C3").Select
End Sub

كما انه تم عمل باقى الطلبات ومن ضمنها -تم انجاز كشف حساب العميل بمعادلات المصفوفة

وهذا هو الملف بعد التعديل

 

gedyana.xlsm