المساعدة لتصميم واجهة مبيعات

[وجدي الحاج علي]

 اقوم بتصميم برنامج محاسبة محل
طلبي هو 
انا اريد في صفحة الاولى 
صفحة (واجهة البيع)
ان اقوم بوضع نوع القطعة وسعر 
وعند الضغط على ترحيل 
يتم نقل المواد الى جدول موجود في صفحة اخرة
مع العلم ان الصفحات الاخرة مرقمة بحسب تاريخ اليوم
اي ان الصفحة رقم 1 هي يوم 1 من الشهر الجاري

وبذلك اريد ان يتم نقل المواد من واجهة البيع الى الجداول حسب تاريخ اليوم

نشالله اكون اوضحت 
تم ارفاق ملف اكسل لشرح اكثر

حسابات محل.rar

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

أخي الكريم وجدي الحاج علي

إليك الكود التالي عله يفي بالغرض

Sub TransferDatabyDay()
    Dim lDay As String, LR As Long
    lDay = Day(Now)
    On Error GoTo YK
    With Sheets(lDay)
        LR = .Cells(65, "C").End(xlUp).Row + 1
        .Range("C" & LR) = Range("H11").Value
        .Range("D" & LR) = Range("J11").Value
    End With
    MsgBox "تمت عملية الترحيل", vbInformation
    Exit Sub
YK:
    MsgBox "لم تتم عملية الترحيل ، قد يكون السبب عدم وجود ورقة العمل", vbCritical
End Sub

في حالة عدم وجود ورقة العمل لليوم الحالي يتم إظهار رسالة تفيد بذلك

لا تنسى تحديد أفضل إجابة وكذلك اضغط على "أعجبني هذا" (يعني قفل الموضوع لو تمت الإجابة عليه بشكل يرضيك)

تقبل الله منا ومنكم

 

حسابات محل.rar

[وجدي الحاج علي]

شكرا على المجهود 
وبارك الله فيكم وبهذا المنتدى الغالي

[وجدي الحاج علي]

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

تم تعديل يوليو 15, 2015 بواسطه وجدي الحاج علي

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

أضف السطر التالي بعد سطر رسالة "تمت عملية الترحيل"

Range("H11:K12").ClearContents

وحاول أن تبتعد قدر الإمكان عن دمج الخلايا لأنه يسبب مشاكل مع الكود

[۩◊۩ أبو حنين ۩◊۩]

الاخ الجليل ياسر خليل

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

جل جميل جدا وبسيط

هل يمكن اضافه 

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

وجزاك الله كل الخير والعافيه

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

الأخ الكريم أبو حنين

كل عام وأنت بخير .. كنت أفضل أن تطرح موضوع مستقل ... ولكن ولا يهمك

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

Sub TransferDatabyDay()
    Dim WS As Worksheet
    Dim lDay As String, LR As Long
    Set WS = Sheets("واجهة البيع")
    lDay = Day(Now)
    
    If blnWorksheetExists(lDay) = False Then
        Sheets.Add After:=Sheets(Sheets.Count)
        With Sheets("Temp")
            .Visible = True
            .Cells.Copy ActiveSheet.Range("A1")
            .Visible = False
        End With
        ActiveSheet.Name = lDay
    End If
    
    With Sheets(lDay)
        LR = .Cells(65, "C").End(xlUp).Row + 1
        .Range("C" & LR) = WS.Range("H11").Value
        .Range("D" & LR) = WS.Range("J11").Value
    End With

    MsgBox "تمت عملية الترحيل", vbInformation
End Sub

Function blnWorksheetExists(strWorksheet As String) As Boolean
    On Error Resume Next
    blnWorksheetExists = Not (ThisWorkbook.Worksheets(strWorksheet) Is Nothing)
    On Error GoTo 0
End Function

تم إنشاء ورقة عمل باسم Temp كنموذج يتم النسخ منه في حالة عدم وجود ورقة عمل

Transfer To Specific Sheet & Create If Not Found.rar

[۩◊۩ أبو حنين ۩◊۩]

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

كل عام وأنت بخير .. وتقبل الله منك صيامك وقيامك وسائر اعمالك

سلمت يداك