รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ
Posted: Sat Sep 15, 2018 2:35 pm
อยากขอความช่วยเหลือครับ
พอดีอยากได้สูตร ที่copy ข้อมูลในขอบเขตที่กำหนดในsheet a ไปวาง ในตำแหน่งที่กำหนดครับsheet bที่กำหนด โดยที่ข้อมูลในการcopyวางต่อกันเรื่อยๆครับ ซึ่งงสูตรด้านล่างอันนี้ ผมดัดแปลงได้เพียง copy จากขอบเขตที่กำหนดไปางในcellสุดท้าย จึงอยากขอความช่วยเหลือครับ รบกวนช่วยเหลือด้วยครับ
Sub ºÑ¹·Ö¡ÂÍ´¢ÒÂ()
Dim Lastrow As Integer
Lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(1 + Lastrow, 2).Value = Cells(4, 2).Value
Cells(2 + Lastrow, 2).Value = Cells(6, 2).Value
Cells(3 + Lastrow, 2).Value = Cells(8, 2).Value
Cells(4 + Lastrow, 2).Value = Cells(10, 2).Value
Cells(5 + Lastrow, 2).Value = Cells(12, 2).Value
Cells(6 + Lastrow, 2).Value = Cells(14, 2).Value
Cells(7 + Lastrow, 2).Value = Cells(16, 2).Value
Cells(8 + Lastrow, 2).Value = Cells(18, 2).Value
Cells(9 + Lastrow, 2).Value = Cells(20, 2).Value
Cells(10 + Lastrow, 2).Value = Cells(22, 2).Value
Cells(11 + Lastrow, 2).Value = Cells(24, 2).Value
Cells(12 + Lastrow, 2).Value = Cells(26, 2).Value
Cells(13 + Lastrow, 2).Value = Cells(28, 2).Value
Cells(1 + Lastrow, 3).Value = Cells(4, 3).Value
Cells(2 + Lastrow, 3).Value = Cells(6, 3).Value
Cells(3 + Lastrow, 3).Value = Cells(8, 3).Value
Cells(4 + Lastrow, 3).Value = Cells(10, 3).Value
Cells(5 + Lastrow, 3).Value = Cells(12, 3).Value
Cells(6 + Lastrow, 3).Value = Cells(14, 3).Value
Cells(7 + Lastrow, 3).Value = Cells(16, 3).Value
Cells(8 + Lastrow, 3).Value = Cells(18, 3).Value
Cells(9 + Lastrow, 3).Value = Cells(20, 3).Value
Cells(10 + Lastrow, 3).Value = Cells(22, 3).Value
Cells(11 + Lastrow, 3).Value = Cells(24, 3).Value
Cells(12 + Lastrow, 3).Value = Cells(26, 3).Value
Cells(13 + Lastrow, 3).Value = Cells(28, 3).Value
Range("B4:C28,F4").Select
Range("F4").Activate
Selection.ClearContents
Range("G20").Select
End Sub
พอดีอยากได้สูตร ที่copy ข้อมูลในขอบเขตที่กำหนดในsheet a ไปวาง ในตำแหน่งที่กำหนดครับsheet bที่กำหนด โดยที่ข้อมูลในการcopyวางต่อกันเรื่อยๆครับ ซึ่งงสูตรด้านล่างอันนี้ ผมดัดแปลงได้เพียง copy จากขอบเขตที่กำหนดไปางในcellสุดท้าย จึงอยากขอความช่วยเหลือครับ รบกวนช่วยเหลือด้วยครับ
Sub ºÑ¹·Ö¡ÂÍ´¢ÒÂ()
Dim Lastrow As Integer
Lastrow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Cells(1 + Lastrow, 2).Value = Cells(4, 2).Value
Cells(2 + Lastrow, 2).Value = Cells(6, 2).Value
Cells(3 + Lastrow, 2).Value = Cells(8, 2).Value
Cells(4 + Lastrow, 2).Value = Cells(10, 2).Value
Cells(5 + Lastrow, 2).Value = Cells(12, 2).Value
Cells(6 + Lastrow, 2).Value = Cells(14, 2).Value
Cells(7 + Lastrow, 2).Value = Cells(16, 2).Value
Cells(8 + Lastrow, 2).Value = Cells(18, 2).Value
Cells(9 + Lastrow, 2).Value = Cells(20, 2).Value
Cells(10 + Lastrow, 2).Value = Cells(22, 2).Value
Cells(11 + Lastrow, 2).Value = Cells(24, 2).Value
Cells(12 + Lastrow, 2).Value = Cells(26, 2).Value
Cells(13 + Lastrow, 2).Value = Cells(28, 2).Value
Cells(1 + Lastrow, 3).Value = Cells(4, 3).Value
Cells(2 + Lastrow, 3).Value = Cells(6, 3).Value
Cells(3 + Lastrow, 3).Value = Cells(8, 3).Value
Cells(4 + Lastrow, 3).Value = Cells(10, 3).Value
Cells(5 + Lastrow, 3).Value = Cells(12, 3).Value
Cells(6 + Lastrow, 3).Value = Cells(14, 3).Value
Cells(7 + Lastrow, 3).Value = Cells(16, 3).Value
Cells(8 + Lastrow, 3).Value = Cells(18, 3).Value
Cells(9 + Lastrow, 3).Value = Cells(20, 3).Value
Cells(10 + Lastrow, 3).Value = Cells(22, 3).Value
Cells(11 + Lastrow, 3).Value = Cells(24, 3).Value
Cells(12 + Lastrow, 3).Value = Cells(26, 3).Value
Cells(13 + Lastrow, 3).Value = Cells(28, 3).Value
Range("B4:C28,F4").Select
Range("F4").Activate
Selection.ClearContents
Range("G20").Select
End Sub