انتقال کامل یک ردیف به شیت دیگر

[paython8]

با سلام
من میخواستم اطلاعات یک ردیف در شیت یکم به صورت کامل درشیت دو کپی بشه با شرط اینکه اگر سلولی از ستون B برابر عدد 1 باشه آنگاه تمام آن ردیف به شیت دو منتقل بشه؟
ممنون میشم راهنمایی کنید بزرگواران

[paython8]

لطفا راهنماییم کنید

[paython8]

هیچکس نیست راهنمایی کند؟؟؟

[majid_mx4]

با سلام لطفا فایل ضمیمه را بررسی نمایید.



موفق باشید میر

[paython8]

سلام جناب میر عزیز
با تشکر فراوان از شما بزرگوار


یک سوال دارم:
در فایل اکسل زیر میخواهم در شیت شماره یک اگر داده های ستون BW  برابر با عدد 1 بود،آنگاه نام دانش آموز از ستون Bکپی شود و در شیت شماره 2 در ستون Aقرار گیرد.


هرچقدر سعی کردم نتونستم ماکرو را تغییر دهم
لطفا راهنماییم کنید.
متشکرم.

[majid_mx4]

با سلام

خدمت شما

کد: [انتخاب]

Sub Copy_mir()
Dim Lastrow As Long
Lastrow = Sheet1.Cells(Rows.Count, "B").End(3).Row
Lastrow2 = Sheet2.Cells(Rows.Count, "a").End(3).Row + 1
Sheet2.Range("a2:L" & Lastrow).Delete

B = 2
For Each Cell In Sheet1.Range("B1:B" & Lastrow)
    If Cell.Offset(0, 73) = 1 Then
        Sheet1.Range("b" & Cell.Row).Copy Sheet2.Range("a" & B)
    B = B + 1
End If
Next
End Sub

پایدار باشید میر

[d349]

با سلام

خدمت شما

کد: [انتخاب]

Sub Copy_mir()
Dim Lastrow As Long
Lastrow = Sheet1.Cells(Rows.Count, "B").End(3).Row
Lastrow2 = Sheet2.Cells(Rows.Count, "a").End(3).Row + 1
Sheet2.Range("a2:L" & Lastrow).Delete

B = 2
For Each Cell In Sheet1.Range("B1:B" & Lastrow)
    If Cell.Offset(0, 73) = 1 Then
        Sheet1.Range("b" & Cell.Row).Copy Sheet2.Range("a" & B)
    B = B + 1
End If
Next
End Sub

پایدار باشید میر

بااجازه استادگرامی جناب آقای میر
انتقال موردنظر بدون کد vba بررسی فرمایید