ترحيل بيانات من جدول المبيعات

[أحمد محمد طلعت]

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

الملف المرفق به اصناف عاوز عند الضغط على زر التقرير يقوم بعمل ترحيل البيانات من جدول المبيعات

بحيث انا لو الصنف موجود نفس الاسم ونفس الربح يضيف على الكمية فى التقرير الكمية لمبيعات اليوم

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

تقرير مبيعات.xlsx

[عبدالله بشير عبدالله]

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

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

الاصناف التي ليس بها مبيعات اي خليتها فارغة لا يرحلها

الكود

Sub TransferData1()
    Dim ws As Worksheet
    Dim lastRow As Long, lastRowJ As Long
    Dim i As Long
    Dim found As Range
    Dim profitMatch As Boolean
    Dim userResponse As VbMsgBoxResult
    
    Set ws = ThisWorkbook.Sheets("ورقة1")
    
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    userResponse = MsgBox("هل تريد الترحيل؟", vbYesNo + vbQuestion, "تأكيد الترحيل")
    
    If userResponse = vbYes Then
        For i = 5 To lastRow
            ' التحقق من وجود بيانات في العمود B
            If ws.Cells(i, "B").Value <> "" Then
                profitMatch = False
                lastRowJ = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
                Set found = ws.Range("J5:J" & lastRowJ).Find(ws.Cells(i, "A").Value, LookIn:=xlValues, LookAt:=xlWhole)
                
                If Not found Is Nothing Then
                    If ws.Cells(i, "E").Value = ws.Cells(found.Row, "N").Value Then
                        ws.Cells(found.Row, "K").Value = ws.Cells(found.Row, "K").Value + ws.Cells(i, "B").Value
                        profitMatch = True
                    End If
                End If
                
                If found Is Nothing Or Not profitMatch Then
                    lastRowJ = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row + 1
                    ws.Cells(lastRowJ, "J").Value = ws.Cells(i, "A").Value
                    ws.Cells(lastRowJ, "K").Value = ws.Cells(i, "B").Value
                    ws.Cells(lastRowJ, "L").Value = ws.Cells(i, "C").Value
                    ws.Cells(lastRowJ, "M").Value = ws.Cells(i, "D").Value
                End If
            End If
        Next i
    End If
End Sub

الملف

تقرير مبيعات1.xlsb