درخواست کمک

[mirzaie2159]

با سلام خدمت اساتید محترم یه مشکلی داشتم خواستم کمک بفرمایید <br>یه ماکرو نوشتم در خصوص ذخیره یه فاکتور که ارسال می کنم لطفا شرط ذیل رو در اون برام بنویسید<br>قبل از ذخیره کردن ابتدا براساس شماره فاکتور جستجو کنه اگر شماره مذکور وجود داشت مواردی رو که می خواد کپی کنه روی اون شماره کپی کنه و اگه سطر کم داشت خودش اضافه کنه و اگه سطر زیاد بود خودش حذف کنه و اگه این شرایط وجود نداشت به آخرین سطر جدول طبق ماکرو اضافه بشه ممنون می شم کمک کنید
Sub RoundedRectangle1_Click()
Sheets(5).Calculate


LastRow = Sheets(5).Range("a23").Value + 1


rowfactor = Sheets(5).Range("b23").Value
For i = 5 To (rowfactor + 4)
If Sheets(5).Range("a" & i) > 0 Then
LastRow = LastRow + 1


Sheets(5).Range("e1").Copy
Sheets(3).Range("a" & LastRow).PasteSpecial


Sheets(5).Range("b3").Copy
Sheets(3).Range("b" & LastRow).PasteSpecial


Sheets(5).Range("E3").Copy
Sheets(3).Range("h" & LastRow).PasteSpecial Paste:=xlPasteValues


Sheets(5).Range("a" & i).Copy
Sheets(3).Range("c" & LastRow).PasteSpecial


Sheets(5).Range("b" & i).Copy
Sheets(3).Range("d" & LastRow).PasteSpecial Paste:=xlPasteValues


Sheets(5).Range("c" & i).Copy
Sheets(3).Range("e" & LastRow).PasteSpecial Paste:=xlPasteValues


Sheets(5).Range("d" & i).Copy
Sheets(3).Range("f" & LastRow).PasteSpecial Paste:=xlPasteValues

Sheets(5).Range("e" & i).Copy
Sheets(3).Range("g" & LastRow).PasteSpecial Paste:=xlPasteValues
End If
Next i
End Sub