Page 1 of 1

รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sat Sep 15, 2018 2:35 pm
by noobvba
อยากขอความช่วยเหลือครับ
พอดีอยากได้สูตร ที่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

Re: รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sat Sep 15, 2018 2:43 pm
by snasui
:D การวาง Code ให้ทำตามกฎการใช้บอร์ดข้อ 5 ตามด้านบน :roll: จะมีตัวอย่างการวาง Code อยู่ครับ จะได้สะดวกต่อการอ่านและให้แสดงผลแตกต่างจากข้อความปกติ

ช่วยแนบไฟล์ตัวอย่างที่มี Code นี้มาด้วยจะได้จะดวกในการช่วยทดสอบครับ

Re: รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sun Sep 16, 2018 9:09 am
by noobvba
อันนี้เป็นไฟล์ แคชเชียร์​ที่ผมอยากพัฒนาให้ ง่ายขึ้น​ครับ รบกวนอาจารย์ช่วยเหลือด้วยครับ
ระบบแคชเชียร์.xlsb

Re: รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sun Sep 16, 2018 10:47 am
by snasui
noobvba wrote: Sat Sep 15, 2018 2:35 pm อยากได้สูตร ที่copy ข้อมูลในขอบเขตที่กำหนดในsheet a ไปวาง ในตำแหน่งที่กำหนดครับsheet bที่กำหนด
:D ไฟล์แนบไม่มีชีตชื่อดังกล่าว ช่วยเขียนชื่อชีต ตำแหน่งเซลล์ ให้สอดคล้องกับชีตตามไฟล์แนบด้วยครับ

Re: รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sun Sep 16, 2018 12:06 pm
by noobvba
snasui wrote: Sun Sep 16, 2018 10:47 am
noobvba wrote: Sat Sep 15, 2018 2:35 pm อยากได้สูตร ที่copy ข้อมูลในขอบเขตที่กำหนดในsheet a ไปวาง ในตำแหน่งที่กำหนดครับsheet bที่กำหนด
:D ไฟล์แนบไม่มีชีตชื่อดังกล่าว ช่วยเขียนชื่อชีต ตำแหน่งเซลล์ ให้สอดคล้องกับชีตตามไฟล์แนบด้วยครับ

ครับอาจารย์ ผมอยากcopy ข้อมูลชื่อสินค้าและจำนวนที่ขาย ในcell b37และc37จนถึง b50และc50 ในหน้าคิดเงิน ไปวางในcell a4 และb4ในsheet 15-9-2018 โดยที่ copyลงมาเรื่อยๆ โดย cell b37 ลงในช่อง A4 และ c37แทนในช่องb4ในsheet 15-9-2018ครับ โดยการกดปุ่มmacroครับโดยข้อมูลเรียงต่อกันไปเรื่อยๆโดยไม่ทับซ้อนกันครับ รบกวนอาจารย์ช่วยคิดสูตรให้หน่อยครับ

Re: รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sun Sep 16, 2018 1:59 pm
by snasui
:D ตัวอย่าง Code ครับ

Code: Select all

Dim r1 As Range
Dim r2 As Range
Dim lastRow As Integer
With Worksheets("หน้าคิดเงิน")
    Set r1 = .Range("a37:a50")
    Set r2 = .Range("b37:b50")
End With
With Worksheets("รายการสินค้า")
    lastRow = .Range("a" & .Rows.Count).End(xlUp).Row + 1
    r1.Copy
    .Range("a" & lastRow).PasteSpecial xlPasteValues
    r2.Copy
    .Range("c" & lastRow).PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False

Re: รบกวนขอสูตร การcopyขอมูลไปวางแบบต่อเนื่องครับ

Posted: Sun Sep 16, 2018 4:30 pm
by noobvba
:thup: :thup: :cp: :cp: ได้แล้วครับ ขอบคุณ​อาจารย์มากเลยครับ :D :D