نویسنده موضوع: انتقال کامل یک ردیف به شیت دیگر  (دفعات بازدید: 156 بار)

paython8

  • کاربر تازه‌وارد
  • *
  • ارسال: 34
  • جمع امتیازها: +0/-0
با سلام
من میخواستم اطلاعات یک ردیف در شیت یکم به صورت کامل درشیت دو کپی بشه با شرط اینکه اگر سلولی از ستون B برابر عدد 1 باشه آنگاه تمام آن ردیف به شیت دو منتقل بشه؟
ممنون میشم راهنمایی کنید بزرگواران

lamp

دانلود فهرست + فصل اول کتاب توابع و فرمول نویسی اکسل

خبر: کامل ترین کتاب توابع و فرمول نویسی در اکسل ترجمه تیم فرساران


paython8

  • کاربر تازه‌وارد
  • *
  • ارسال: 34
  • جمع امتیازها: +0/-0
لطفا راهنماییم کنید >:(

paython8

  • کاربر تازه‌وارد
  • *
  • ارسال: 34
  • جمع امتیازها: +0/-0
هیچکس نیست راهنمایی کند؟؟؟ >:(

majid_mx4

  • مدیران انجمن
  • *
  • ارسال: 1962
  • جمع امتیازها: +790/-7
با سلام لطفا فایل ضمیمه را بررسی نمایید.



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

paython8

  • کاربر تازه‌وارد
  • *
  • ارسال: 34
  • جمع امتیازها: +0/-0
سلام جناب میر عزیز
با تشکر فراوان از شما بزرگوار


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


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

lamp

دانلود فهرست + فصل اول کتاب توابع و فرمول نویسی اکسل

خبر: کامل ترین کتاب توابع و فرمول نویسی در اکسل ترجمه تیم فرساران


majid_mx4

  • مدیران انجمن
  • *
  • ارسال: 1962
  • جمع امتیازها: +790/-7
با سلام

خدمت شما

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

  • کاربر فعال
  • ***
  • ارسال: 171
  • جمع امتیازها: +3/-0
با سلام

خدمت شما

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 بررسی فرمایید