کپی یک محدوده در سطر با vba

[علی فاطمی]

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

Sub Row()
Dim lastrowair As Long, lastcolumnair As Long
lastrowair = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowair
If Sheet3.Cells(i, 1) = Sheet2.Range("B2") Then

در شیت 2 سلول b2 یک لیست از ستون A در شیت 3 تعریف کردم که حاوی یه سری کد محصول می باشد .
با انتخاب کد محصول در این لیست و دستور فوق اکسل تو شیت3 و ستون A می گرده و کد محصول رو پیدا می کنه ( مثلا من کد M144T رو می دم که در ردیف 4 ستون قرارداره)
حالا با این دستور میره و آخرین رکورد اون کد محصول رو در سطر روبروی خودش رو هم پیدا می کنه.

lastcolumnair = Sheet3.Cells(i, Columns.Count).End(xlToLeft).Column


من می خوام دستوری بنویسم که اطلاعات اون سطر رو کپی کنم.
با دستور زیر میشه کل سطر رو کپی کرد :
Sheet3.Cells(i, 2).EntireRow.Copy

ولی من می خوام فقط محدوده ای که اطلاعات وجود داره رو کپی کنه . ( توی مثال بالا میشه ردیف 4 از ستون دومش تا ستون 64 )

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

متاسفانه چند روزه اصلا نمی دونم چرا نمیشه فایل آپلود کرد .

با سپاس فراوان

[Ali Parsaei]

سلام علي آقاي گل،
البته چون فايل نشده آپلود کنيد يک کم فهميدن مطلب سخته ولي ببينيد به جاي Sheet3.Cells(i, 2).EntireRow.Copy اگر از کد زير استفاده کنيد درست ميشه؟

Sheet3.Range(Cells(i, 2), Cells(i, 2).End(xlToRight)).Copy 

[علی فاطمی]

سلام علي آقاي گل،
البته چون فايل نشده آپلود کنيد يک کم فهميدن مطلب سخته ولي ببينيد به جاي Sheet3.Cells(i, 2).EntireRow.Copy اگر از کد زير استفاده کنيد درست ميشه؟

Sheet3.Range(Cells(i, 2), Cells(i, 2).End(xlToRight)).Copy 

جناب پارسایی عزیز سلام وقت شما بخیر
ممنون از توجه شما .
ولی همچنان جواب نگرفتم.


Sub copyrows2()
Dim lastrowair As Long, lastcolumnair As Long
lastrowair = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowair
If Sheet3.Cells(i, 1) = Sheet2.Range("B2") Then


lastcolumnair = Sheet3.Cells(i, Columns.Count).End(xlToLeft).Column


Sheet3.Range(Cells(i, 2), Cells(i, 2).End(xlToRight)).Copy


Sheet1.Range("c4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True


End If


Next i


Sheets("Sheet2").Select


End Sub

[علی فاطمی]

عرض سلام خدمت همه عزیزان
و تشکر ویژه از استاد علی پارسایی عزیز
من مشکلم رو به صورت زیر حل کردیم

Sub copyrows2()


Dim lastrowair As Long, lastcolumnair As Long
Dim aaa As String
lastrowair = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastrowair
If Sheet3.Cells(i, 1) = Sheet2.Range("B2") Then


lastcolumnair = Sheet3.Cells(i, Columns.Count).End(xlToLeft).Column


aaa = Split(Cells(i, lastcolumnair).Address, "$")(1)
Sheet3.Range("B" & i & ":" & aaa & i).Copy
Sheet1.Range("c5").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True


End If


Next i


Sheets("Sheet2").Select




End Sub

امیدوارم برای کس دیگه ای هم مفید باشه .