[حل شده] کمک در حذف موجودی انبار با وارد کردن کد کالا

[ACE]

سلام»
من یک فایل انبار ایجاد کردم که در آن تعدادی دستگاه دارم با سریال متفاوت با مدلهای مختلف.می خوام در شیت "فسخ به انبار" وقتی شماره سریال دستگاه را وارد می کنم ابتدا پیغام "شما از اظمینان دارید"ظاهر شود بعد که تایید زدم شماره سریال از انبار اصلی حذف شود و در شیت " فسخ به انبار"وارد شود.البته یک مورد وجود دارد اینکه در شیت"انبار اصلی"در ستون c (مدل دستگاه)هم پس از حذف سریال نیز حذف شود در واقع سطر مربوط به سریال کاملا حذف شود.
چیزی شبیه به این پست:
انتقال چند سطر از یک شیت به شیت دیگر

ممنون

[ACE]

سلام...کسی نیست کمک کند؟

[ACE]

????

[Amir Ghasemiyan]

سلام دوست عزیز

یکی دو روز صبر کنید بعد اگه جواب سوالتو رو نگرفتین پست بزنین تاپیکتون بیاد بالا. کسایی که میتونن پاسخ سوالتون رو بدن ۲۴ ساعت تو سایت آنلاین نیستن

و اما جواب سوالتون. شما باید از کدهای vba استفاده کنید. من کد و فایل نمونه رو خدمتتون تقدیم میکنم

Sub EI_RemoveSerial()
Serial = Range("F7").Value
If Not IsNumeric(Serial) Then Exit Sub
Lrow1 = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Lrow2 = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row
For Each cel In Sheet1.Range("B2:B" & Lrow1)
    If cel.Value = Serial Then
        ThisRow = cel.Row
        Sheet1.Range("A" & ThisRow & ":C" & ThisRow).Copy
        Sheet2.Range("A" & Lrow2 + 1 & ":C" & Lrow2 + 1).PasteSpecial
        Sheet2.Range("A" & Lrow2 + 1).FormulaR1C1 = "=IF(ISBLANK(RC[1])=TRUE,"""",COUNTA(R1C1:R[-1]C))"
        Sheet1.Range("A" & ThisRow & ":C" & ThisRow).Delete Shift:=xlUp
        Exit Sub
    End If
Next cel
End Sub


Sub EI_Warning()
msg = MsgBox("do you realy want remove this serial?", vbYesNo)
If msg = 6 Then EI_RemoveSerial
End Sub

[ACE]

سلام دوست عزیز

یکی دو روز صبر کنید بعد اگه جواب سوالتو رو نگرفتین پست بزنین تاپیکتون بیاد بالا. کسایی که میتونن پاسخ سوالتون رو بدن ۲۴ ساعت تو سایت آنلاین نیستن

و اما جواب سوالتون. شما باید از کدهای vba استفاده کنید. من کد و فایل نمونه رو خدمتتون تقدیم میکنم

Sub EI_RemoveSerial()
Serial = Range("F7").Value
If Not IsNumeric(Serial) Then Exit Sub
Lrow1 = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
Lrow2 = Sheet2.Range("A" & Sheet2.Rows.Count).End(xlUp).Row
For Each cel In Sheet1.Range("B2:B" & Lrow1)
    If cel.Value = Serial Then
        ThisRow = cel.Row
        Sheet1.Range("A" & ThisRow & ":C" & ThisRow).Copy
        Sheet2.Range("A" & Lrow2 + 1 & ":C" & Lrow2 + 1).PasteSpecial
        Sheet2.Range("A" & Lrow2 + 1).FormulaR1C1 = "=IF(ISBLANK(RC[1])=TRUE,"""",COUNTA(R1C1:R[-1]C))"
        Sheet1.Range("A" & ThisRow & ":C" & ThisRow).Delete Shift:=xlUp
        Exit Sub
    End If
Next cel
End Sub


Sub EI_Warning()
msg = MsgBox("do you realy want remove this serial?", vbYesNo)
If msg = 6 Then EI_RemoveSerial
End Sub

سلام و تشکر از شما :
بسیار عالی فقط یک مورد :
تمامی موارد را انتقال می دهد اما اگر در شیت دوم سطری پاک شود در انتقال بعدی اون سطر جایگزین نمی شود...
در واقع سطرهای خالی در حافظه مانده است.و به طریقه ای نمایش می دهد انگار سلول محتوا دارد در صورتیکه خالی است
ممنون می شوم این مورد را نیز راهنمایی بفرمایید.

[Amir Ghasemiyan]

درخواست دوستمون جهت تکمیل شدن تبدیل به پروژه شد
بنابراین این تاپیک بصورت حل شده در خواهد آمد