ترحيل المبيعات والمشتريات

[أيهاب ممدوح]

السلام عليكم

ارجوا المساعده في الملف

المطلوب الاول هو عند تسجيل رقم الكود يستعدعي اسم الصنف وبعد تسجيل سعر البيع والملاحظات يتم الترحيل حسب الكود واسم الصفحه وبعدها يتم نقل نسخه من الصنف الي شيت المبيعات (بحيث يدرج في صفه المخزون كميه البيع وسعر البيع + ويرحل نسخه من الصنف بالكامل الي صفحه المبيعات

المطلوب الثاني هو عمليه الشراء عند تحديد اسم الصفحه يتم ترحيل البيات الي اخر صف بالصفحه وكذلك عمله نسخه بصفحه المشتريات

شكرا مقدما

مبيعات ومشتريات.xlsx

[محمد هشام.]

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

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

[أيهاب ممدوح]

مساء الخير 

بخصوص الطلب الاول

المبيعات

بيحدث امرين الاول يتم تسجيل المبيعات في المخزون ( مقسم الي 3 صفحات لكل نوع صفحه ) لتقليل الكميه وفي نفس الشيت المخزن يتم تسجيل السعر البيع والملاحظات 

الامر الثاني يتم تسجيل المبيعات في شيت مستقل بكامل البيانات المتاحه من كود واسم وسعر وتاريخ يوم البيع والملاحظات

المشتريات

يحدث امرين تسجيل الصنف في المخزون في اخر صف 

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

اتمني ان اكون وضحت 

مبيعات ومشتريات.xlsx

[محمد هشام.]

الفكرة بالنسبة للمبيعات  هي عند اختيار  اسم صفحة المخزون من الخلية C3  سيتم انشاء قائمة منسدلة بأكواد الصنف المتوفرة في نفس الصفحة المختارة  تلقائيا  لتسهيل عملية البحث وعند اختيار كود الصنف يتم جلب اسم الصنف وبعد ادخال السعر والملاحظات والظغط على زر الترحيل يتم ترحيل بيانات التسجيل الى الصفحة المختارة مع ترحيل نفس البيانات الى ورقة المبيعات في الاعمدة المناسبة و اظافة تاريخ اليوم في العمود الاول من الجدول 

المشتريات 

 بعد تحديد الصفحة الهدف من الخلية G3 واظافة بيانات التسجيل كود الصنف- اسم الصنف-السعر-الملاحظات  يتم ترحيلها الى الصفحة المحددة مع نسخ نفس البيانات المتاحة لجدول المشتريات في الاعمدة المناسبة 

ادا كانت قد فهمت طلبك بشكل صحيح فهدا سيوفي بالغرض

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

Sub CopyDatasale()
    Call ProcessTransfer("تسجيل", "المبيعات", Array(1, 2, 7, 8), Array(2, 3, 8, 9), True)
End Sub

Sub CopyDatabuy()
    Call ProcessTransfer("تسجيل", "المشتريات", Array(1, 2, 7, 8), Array(1, 2, 7, 8), False)
End Sub
'=======================================
Sub ProcessTransfer(registrationSheetName As String, destName As String, _
stockColumnsArr As Variant, salesColumnsArr As Variant, Cnt As Boolean)

    Dim WS As Worksheet, f As Worksheet, dest As Worksheet
    Dim arr As Variant, list As String, MSg As VbMsgBoxResult
    Dim i As Long

    Set WS = ThisWorkbook.Sheets(registrationSheetName)
    Set dest = ThisWorkbook.Sheets(destName)

    If destName = "المشتريات" Then
        arr = Array(WS.[G4], WS.[G5], WS.[G6], WS.[G7])
        list = WS.[G3].Value
    Else
        arr = Array(WS.[C4], WS.[C5], WS.[C6], WS.[C7])
        list = WS.[C3].Value
    End If

    For i = 0 To 3
        If arr(i) = "" Then
            MsgBox "يرجى إدخال: " & arr(i).Offset(0, -1), vbExclamation, "إنتباه"
            arr(i).Select
            Exit Sub
        End If
    Next

    On Error Resume Next
    Set f = ThisWorkbook.Sheets(list)
    On Error GoTo 0
    If f Is Nothing Then
        MsgBox "قائمة المخزون " & list & " غير موجودة", vbExclamation
        Exit Sub
    End If

    If MsgBox("ترحيل البيانات؟", vbYesNo + vbQuestion, "تأكــيد") = vbNo Then Exit Sub
    
    RegistrationData f, arr, stockColumnsArr
    RegistrationData dest, arr, salesColumnsArr, Cnt

    MsgBox list & ": تم ترحيل البيانات بنجاح إلى " & destName & " وقائمة المخزون", vbInformation

    MSg = MsgBox("هل ترغب في إفراغ بيانات التسجيل؟", vbYesNo + vbQuestion, "تفريغ الخلايا")
    If MSg = vbYes Then
        If destName = "المشتريات" Then
            WS.[G3:G7].ClearContents
        Else
            WS.[C3:C7].ClearContents
        End If
      End If
    
End Sub
'=======================================
Sub RegistrationData(sheet As Worksheet, arr As Variant, columnsArr As Variant, Optional Cnt As Boolean = False)
    Dim tbl As ListObject, lige As Range, TabBD As Range, i As Long
    
    Set tbl = sheet.ListObjects(1)
    Set lige = tbl.ListColumns(2).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    Set TabBD = IIf(lige Is Nothing, tbl.ListRows(1).Range, lige.Offset(1))

    If Cnt Then
        TabBD.Cells(1, 1).Value = Format(Date, "dd/mmmm")
    End If
    For i = LBound(arr) To UBound(arr)
        TabBD.Cells(1, columnsArr(i)).Value = arr(i).Value
    Next i
End Sub

وفي حدث ورقة التسجيل ضع الكود التالي 

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dest As Worksheet, i As Long, lastRow As Long, TabBD As Boolean, Sh As String, itemCode As String, _
                           dict As Object, CRng As Range, a As Variant, tmp As Variant
    
Dim WS As Worksheet: Set WS = Sheets("تسجيل")

    On Error GoTo ErrorHandler
        Sh = Me.Range("C3").Value
        itemCode = Me.Range("C4").Value
        TabBD = False
        If Sh = "" Then Exit Sub
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    Select Case Target.Address
        Case Me.Range("C3").Address
            If Not Check(Sh, dest) Then
                TabBD = True
            Else
                lastRow = dest.Cells(dest.Rows.Count, "C").End(xlUp).Row
                Set CRng = dest.Range("C4:C" & lastRow)
                tmp = CRng.Value

                Set dict = CreateObject("Scripting.Dictionary")
                For i = 1 To UBound(tmp, 1)
                    If tmp(i, 1) <> "" And Not dict.Exists(tmp(i, 1)) Then
                        dict.Add tmp(i, 1), Nothing
                    End If
                Next i

                With WS.Range("L3:L" & WS.Cells(WS.Rows.Count, "L").End(xlUp).Row)
                    .ClearContents
                End With

                If dict.Count > 0 Then
                    With WS.Range("L3").Resize(dict.Count)
                        .Value = Application.Transpose(dict.Keys)
                    End With
                End If

                WS.Range("C4:C5").Value = ""
                Call Add_listeDéroulante
            End If

        Case Me.Range("C4").Address
            If Sh = "" Or itemCode = "" Then
                TabBD = True
            Else
                If Not Check(Sh, dest) Then
                    TabBD = True
                Else
                    lastRow = dest.Cells(dest.Rows.Count, "C").End(xlUp).Row
                    Set CRng = dest.Range("C4:C" & lastRow)
                    tmp = CRng.Value
                    
                    a = Application.Match(itemCode, Application.Index(tmp, 0, 1), 0)
                    If Not IsError(a) Then
                    WS.Range("C5").Value = dest.Cells(a + 3, "D").Value
                    Else
                             WS.Range("C5").Value = ""
                        TabBD = True
                    End If
                End If
            End If
 End Select
ExitHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Exit Sub

ErrorHandler:
    MsgBox "Error : " & Err.Description, vbExclamation
    TabBD = True
    Resume ExitHandler
End Sub
Function Check(sheetName As String, ByRef dict As Worksheet) As Boolean
    On Error Resume Next
    Set dict = Sheets(sheetName)
    On Error GoTo 0
    If dict Is Nothing Then
        MsgBox "غير موجودة" & " " & sheetName & "  : " & "الصفحة", vbExclamation
        Check = False
    Else
        Check = True
    End If
End Function

 

مبيعات ومشتريات.xlsb

تم تعديل سبتمبر 13 بواسطه محمد هشام.

[أيهاب ممدوح]

اولا جزاك الله خير وشكرا جدا الحل ممتاز جدا

لو تكرمت بعض التعديلات البسيطه بخصوص المبيعات عند اختيار كود الصنف ( يرجي اظهار الوصف وليس اسم الصنف ) 

مع اضافه كميه المبيعات بقيمه 1 في ملف الصنف ( عامود المبيعات) بحيث يتم خصمه من المخزون وادخال تاريخ اليوم للعمليه في صفحه المخزون (عامود ترايخ البيع )

وعند الترحيل الي صفحه المبيعات يقوم بترحيل الصف من صفحه المخزون للمنتج بالكامل 

 

الشراء 

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

مع اضفاه الكميه ( الكميه ثابته دائمه 1) لجميع الاصناف 

بخصوص السعر يذهب الي سعر الوحده وليس سعر البيع

شكرا جدا مقدما

مبيعات ومشتريات.xlsb

[محمد هشام.]

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

هناك بعض النقط يجب توضيحها 

1) اضافه كميه المبيعات بقيمه 1 في ملف الصنف ( عامود المبيعات) بحيث يتم خصمه من المخزون ( مادا تقصد بالخصم واعتمادا على اي معيار ) 

2)  منع تكرار الكود بحيث يختار اخر كود ولصنا له ويضيف الكود التالي له (هيتم جلب اخر كود  من اين )

[أيهاب ممدوح]

بخصوص منع التكرار 

بعد التجربه ظهر انه من الامكان تسجيل الكود مرتين بالتالي يحدث تضارب في المبيعات

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

 

[محمد هشام.]

42 دقائق مضت, محمد هشام. said:

مادا تقصد بالخصم واعتمادا على اي معيار

 

[أيهاب ممدوح]

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

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

المعيار انها تم بيعها و بالتالي غير موجوده بالمخزون

[محمد هشام.]

في 14‏/9‏/2024 at 15:34, أيهاب ممدوح said:

بخصوص منع التكرار 

بعد التجربه ظهر انه من الامكان تسجيل الكود مرتين بالتالي يحدث تضارب في المبيعات

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

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

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

هناك احتمالية الاستغناء عن خلية ادخال الكود وتعويضها داخل الكود بانشاء تسلسل تلقائي للاكواد اي جلب اخر كود تم ترحيله مع اظافة +1 

لهدا يصعب التعامل مع الملف في غياب معطيات كافية بالتفصيل 

[أيهاب ممدوح]

بالنسبه للشراء 

فعلا المطلوب بخصوص كود المنتج ان يتم تلقائي مع اخر كود باضافه +1

 بخصوص المبيعات لا يوجد تعديل سوي ادخال كميه 1 في كمه البيع بالمخزون وتاريخ اليوم فقط للعمليه 

[محمد هشام.]

يعني مسالة تكرار الكود واردة

[أيهاب ممدوح]

لا غير وراد تكرار الكود للمنتج 

 

[محمد هشام.]

انا بتكلم عند الترحيل الى صفحات المخزون هناك شيء غير مفهوم  لكي نكون اكثر وضوحا جرب هدا لترحيل البيانات الى صفحات المخزون وورقة المبيعات ووافيني بالنتيجة 

Sub CopyDatasale()
    Dim ws As Worksheet, f As Worksheet, dest As Worksheet
    Dim Sh As String, arr As Variant, rngToCopy As Range
    Dim tbl As ListObject, Tbl2 As ListObject, i&
    Dim OnRng As Range, Irow As Range, a As Range, n As Range

    Set ws = Sheets("تسجيل")
    Set dest = Sheets("المبيعات")
    Sh = ws.[C3].Value: Set f = ThisWorkbook.Sheets(Sh)
   
    arr = Array(ws.[C4], ws.[C5], ws.[C6], ws.[C7])
     For i = 0 To 3
     If arr(i) = "" Then MsgBox "يرجى إدخال: " & arr(i).Offset(0, -1), vbExclamation, "إنتباه": ws.Activate: arr(i).Select: Exit Sub
    Next
  On Error Resume Next
    Set f = ThisWorkbook.Sheets(Sh)
    On Error GoTo 0
    If f Is Nothing Then
        MsgBox "قائمة المخزون " & Sh & " غير موجودة", vbExclamation
        Exit Sub
    End If
    Dim MSg As VbMsgBoxResult
    MSg = MsgBox("هل ترغب في ترحيل بيانات التسجيل؟", vbYesNo + vbQuestion, "تأكيد الترحيل")
    If MSg = vbNo Then Exit Sub

    Set tbl = f.ListObjects(1)
    Set Tbl2 = dest.ListObjects(1)
    Set OnRng = tbl.ListColumns(2).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not OnRng Is Nothing Then
        Set a = OnRng.Offset(1)
    Else
        Set a = tbl.ListRows(1).Range
    End If

    '==== ترحيل البيانات إلى ورقة المخزون =====
    a.Cells(1, 1).Value = arr(0)  ' كود الصنف
    a.Cells(1, 3).Value = arr(1)  ' الاسم
    a.Cells(1, 6).Value = 1       ' الكمية
    a.Cells(1, 4).Value = arr(2)  ' الوصف
    a.Cells(1, 8).Value = arr(3)  ' الملاحظات
    a.Cells(1, 10).Value = Format(Date, "dd/mmmm")  ' التاريخ

    Set OnRng = tbl.ListColumns(2).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    Set Irow = Tbl2.ListColumns(3).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)

    If Not Irow Is Nothing Then
        Set n = Irow.Offset(1).Resize(1, 10)
    Else
        Set n = Tbl2.ListRows(1).Range.Resize(1, 10)
    End If
    '==== ترحيل البيانات إلى ورقة المبيعات =====

    Set rngToCopy = OnRng.Resize(1, 10)
    n.Value = rngToCopy.Value
    n.Cells(1, 1).Offset(0, -1).Value = Format(Date, "dd/mmmm")

End Sub

 

[أيهاب ممدوح]

تم التجربه بخصوص الترحيل الي صفحه المبيعات ممتاز 

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

مرسل ملف التجربه

مبيعات ومشتريات.xlsb

[محمد هشام.]

ادن ما نفهمه الان انك رغم ادخالك مثلا  w3  يتم تجاهله واظافة كود جديد w4

 

[أيهاب ممدوح]

هذا ما يحدث وهذا غير المطلوب

المطلوب هو الاضافه الي نفس المنتج اضافه باقي البيانات من كميه 1 وتاريخ البيع وسعر البيع والملاحظات 

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

وعند استدعاء اصم الصنف يتم استعداء الوصف  وليس الاسم

 

[محمد هشام.]

2 ساعات مضت, أيهاب ممدوح said:

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

وعند استدعاء اصم الصنف يتم استعداء الوصف  وليس الاسم

تم تعديلها مع اظافة امكانية جلب اخر كود في الصفحة الهدف عند التغيير في الخلية G3 

 

جرب هدا للمبيعات 

 

 

 

 

Sub TransferData1()
    Dim ws As Worksheet, dest As Worksheet, sWS As Worksheet
    Dim arr As Variant, xdate As String
    Dim Clé As String, a As Range, n As Range
    Dim Sht As String, tbl2 As ListObject, Irow As Range

    xdate = Format(Date, "dd/mmmm")
    Set ws = Sheets("تسجيل")
    Sht = ws.Range("C3").Value

    On Error Resume Next
    Set dest = Sheets(Sht)
    On Error GoTo 0
    If dest Is Nothing Then
        MsgBox "صفحة المخازن" & Sht & " غير موجودة", vbExclamation
        Exit Sub
    End If
    Set sWS = Sheets("المبيعات")
    Clé = ws.Range("C4").Value
    arr = Array(ws.Range("C4").Value, ws.Range("C5").Value, ws.Range("C6").Value, ws.Range("C7").Value)
    
    For i = 0 To 3
        If arr(i) = "" Then
            MsgBox "يرجى إدخال: " & ws.Cells(4 + i, 2).Value, vbExclamation, "تنبيه"
            ws.Activate
            ws.Cells(4 + i, 3).Select
            Exit Sub
        End If
    Next i
    Set a = dest.Columns("C").Find(What:=Clé, After:=dest.Cells(4, 3), LookIn:=xlValues, LookAt:=xlWhole)
    If a Is Nothing Then
        MsgBox "لم يتم العثور على ُمعرّف المخزون " & Clé, vbExclamation
        Exit Sub
    End If
    a.Offset(0, 2).Value = arr(1)
    a.Offset(0, 6).Value = arr(2)
    a.Offset(0, 7).Value = arr(3)
    a.Offset(0, 5).Value = 1
    a.Offset(0, 9).Value = xdate
    Set tbl2 = sWS.ListObjects(1)
    Set Irow = tbl2.ListColumns(3).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    If Not Irow Is Nothing Then
        Set n = Irow.Offset(1).Resize(1, tbl2.ListColumns.Count)
    Else
        Set n = tbl2.ListRows(1).Range.Resize(1, tbl2.ListColumns.Count)
    End If
    n.Cells(1, 1).Offset(0, -1).Value = xdate
    n.Cells(1, 1).Resize(1, 10).Value = a.Resize(1, 10).Value
    MsgBox "تم ترحيل البيانات بنجاح", vbInformation
End Sub

 

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

مبيعات ومشتريات V1.xlsb

[أيهاب ممدوح]

السلام عليكم

بخصوص المبيعات والمخزون بارك الله فيك ممتاز

المشتريات الكود لا يعمل

[محمد هشام.]

14 ساعات مضت, أيهاب ممدوح said:

المشتريات الكود لا يعمل

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

على العموم على حسب ما فهمت الى غاية اللحظة ربما هدا ما تحاول فعله 

Sub TransferData2()
    Dim i As Long, Cnt As Long
    Dim ws As Worksheet, f As Worksheet, sWS As Worksheet
    Dim Sh As String, arr As Variant
    Dim tbl As ListObject, a As Range, lige As Range
    Dim j As String, newCode As String, b As String

    Set ws = ThisWorkbook.Sheets("تسجيل")
    Sh = ws.[G3].Value
   
    arr = Array(ws.[G4], ws.[G5], ws.[G6], ws.[G7])
    For i = 0 To 3
        If arr(i) = "" Then
            MsgBox "يرجى إدخال: " & arr(i).Offset(0, -1), vbExclamation, "إنتباه"
            ws.Activate: arr(i).Select
            Exit Sub
        End If
    Next
    On Error Resume Next
    Set f = ThisWorkbook.Sheets(Sh)
    On Error GoTo 0
    If f Is Nothing Then
        MsgBox "قائمة المخزون " & Sh & " غير موجودة", vbExclamation
        Exit Sub
    End If

    If MsgBox("هل ترغب في ترحيل بيانات التسجيل؟", vbYesNo + vbQuestion, "تأكيد الترحيل") = vbNo Then Exit Sub
    Set tbl = f.ListObjects(1)
    On Error Resume Next
    Set lige = tbl.ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeConstants).Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    On Error GoTo 0

    '  الكود الجديد
    If Not lige Is Nothing Then
        j = lige.Value
        b = Left(j, Len(j) - Len(CStr(Val(j))))
        Cnt = Val(Right(j, Len(j) - Len(b)))
        newCode = b & Cnt + 1
    Else
        newCode = ws.[G4].Value
    End If
    If Not lige Is Nothing Then
        Set a = lige.Offset(1, 0)
    Else
        Set a = tbl.ListColumns(2).DataBodyRange.Cells(1, 1)
        If a.Value <> "" Then
            Set a = tbl.ListColumns(2).DataBodyRange.Cells(tbl.ListRows.Count + 1, 1)
        End If
    End If

    a.Value = newCode ' الكود
    a.Offset(0, 5).Value = 1 ' الكمية
    a.Offset(0, 2).Value = arr(1) ' الاسم
    a.Offset(0, 3).Value = arr(2) ' الوصف
    a.Offset(0, 7).Value = arr(3) ' الملاحظات
    a.Offset(0, 9).Value = Format(Date, "dd/mmmm") ' التاريخ

    Set sWS = Sheets("المشتريات")
    Set tbl = sWS.ListObjects(1)
   On Error Resume Next
    Set lige = tbl.ListColumns(3).Range.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    On Error GoTo 0

    If Not lige Is Nothing Then
        Set a = lige.Offset(1, 0)
    Else
        Set a = tbl.ListColumns(3).DataBodyRange.Cells(1, 1)
        If a.Value <> "" Then
            Set a = tbl.ListColumns(3).DataBodyRange.Cells(tbl.ListRows.Count + 1, 1)
        End If
    End If
    a.Cells(1, 1).Offset(0, -1).Value = Format(Date, "dd/mmmm") ' التاريخ
    a.Value = newCode ' الكود
    a.Offset(0, 5).Value = 1 ' الكمية
    a.Offset(0, 2).Value = arr(1) ' الاسم
    a.Offset(0, 3).Value = arr(2) ' الوصف
    a.Offset(0, 7).Value = arr(3) ' الملاحظات
    a.Offset(0, 9).Value = Format(Date, "dd/mmmm") ' التاريخ
End Sub

 

 

مبيعات ومشتريات V1.xlsb

تم تعديل سبتمبر 18 بواسطه محمد هشام.

[أيهاب ممدوح]

السلام عليكم

جزاك الله خير استاذ هشام

هو المطلوب ممتاز

لو أمكن كود تفريغ الخلايا بعد التسجيل شواء شراء او البيع في صفحه التسجيل

[محمد هشام.]

10 دقائق مضت, أيهاب ممدوح said:

و أمكن كود تفريغ الخلايا بعد التسجيل شواء شراء او البيع في صفحه التسجيل

يمكنك اظافة الكود التالي في اخر الكود  مع تعديل عناوين الخلايا بما يناسبك 

If MsgBox("تفريغ بيانات التسجيل ", vbYesNo + vbQuestion, "تأكيـــد") = vbYes Then
        ws.Range("G3:G7").ClearContents
    End If
    MsgBox "تم ترحيل البيانات بنجاح", vbInformatio