[حل شده] تکرار ردیفها با استفاده از شرط

[habib100]

با سلام و خسته نباشید خدمت همه دوستان
فایل اکسلی را به همراه توضیحات ضمیمه کرده ام، خواهشمندم راهنمایی بفرمائید.
باتشکر

[M_ExceL]

با سلام و خسته نباشید خدمت همه دوستان
فایل اکسلی را به همراه توضیحات ضمیمه کرده ام، خواهشمندم راهنمایی بفرمائید.
باتشکر

سلام،

Sub M_Excel()
Dim rng1, rng2 As Range
Dim b, lr As Long
    lr = Sheets(2).Cells(Rows.Count, 2).End(3).Row
    b = lr
        Do Until b = lr + 4
            b = b + 1
            Set rng1 = Sheets(1).Range("b2").Resize(, 3)
            Set rng2 = Sheets(2).Range("a" & b).Resize(, 3)
            rng2.Value = rng1.Value
        Loop
End Sub

[habib100]

با سلام
ممنونم . اگر بخواهم از ردیف سوم شیت مبلغ خرید روز بخواند و بعد از کلیک کردن بر روی باتن آن روز و تاریخ نوشته شده در ردیف 3 به ردیف 2 همان شیت منتقل شود یعنی کات شود به ردیف دومی و ردیف سوم خالی بماند باید چه تغییری در دستور بدهم؟
خیلی زحمت کشیدید ممنونم.

[M_ExceL]

با سلام
ممنونم . اگر بخواهم از ردیف سوم شیت مبلغ خرید روز بخواند و بعد از کلیک کردن بر روی باتن آن روز و تاریخ نوشته شده در ردیف 3 به ردیف 2 همان شیت منتقل شود یعنی کات شود به ردیف دومی و ردیف سوم خالی بماند باید چه تغییری در دستور بدهم؟
خیلی زحمت کشیدید ممنونم.

خواهش میکنم،
به این صورت میشه :

Sub M_Excel()

Dim rng1, rng2 As Range
Dim b, lr As Long
    lr = Sheets(2).Cells(Rows.Count, 2).End(3).Row
    b = lr
        Do Until b = lr + 4
            b = b + 1
            Set rng1 = Sheets(1).Range("b3").Resize(, 3)
            Set rng2 = Sheets(2).Range("a" & b).Resize(, 3)
            rng2.Value = rng1.Value
        Loop
rng1.Cut Destination:=Sheets(1).Range("B2:D2")
        
End Sub

[habib100]

خیلی ممنون . متشکرم