รบกวนขียนโค้ดย้ายข้อมูลจากชีทนึงมาอีกชีทนึงแบบ item ละ 10 บรรทัดให้หน่อยค่ะ

[ca_jaoa]

มี 2 ชีท อยากเอา item code จากชีท raw data มาใส่ อีกชีท "sheet1" แถวละ c1-c10 ไรแบบนี้ค่ะ
ทำได้แค่นี้ค่ะ แต่ทำให้มันมาอีก 10 บรรทัดไม่ได้ค่ะ

Sub AddItem()

Dim rngInput As Range
Set rngInput = Sheets("Raw Data").Range("a1:a3000")

Dim rngOutput As Range
Set rngOutput = Sheets("Sheet1").Range("c6:c2000")

Dim i As Long
For i = 1 To 26

rngOutput(i).Value = rngInput(i).Value
For y = 1 To 26
Sheet1.Cells(y, i) = rngInput.Value
Next y
Next i

End Sub

[snasui]

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

สำหรับการเขียน Code ในกระทู้ ควรกำหนดให้แสดงเป็น Code จะได้สะดวกในการอ่านและการ Copy ไปทดสอบ ดูตัวอย่างที่นี่ครับ viewtopic.php?f=6&t=1187

[ca_jaoa]

อยานำข้อมูลจากภาพที่ 1 มาใส่ภาพที่ 2 ค่ะ ลองเขียน code ดูแล้วแต่ไม่ได้ค่พ

Code: Select all

Sub AddItem()

Dim rngInput As Range
Set rngInput = Sheets("Raw Data").Range("a1:a3000")

Dim rngOutput As Range
Set rngOutput = Sheets("Sheet1").Range("c6:c2000")

Dim i As Long
For i = 1 To 26
    
    rngOutput(i).Value = rngInput(i).Value
        For y = 1 To 26
        Sheet1.Cells(y, i) = rngInput.Value
    Next y
Next i

End Sub

[XDoll]

เข้าใจว่าเป็นกระทู้เดียวกันกับ http://www.snasui.com/viewtopic.php?t=9769 หากเป็นเรื่องเดิมควรถามต่อในกระทู้เดิมนะครับ และ หากมีปัญหาเรื่อง code ควรแนบไฟล์ที่เป็นปัญหา เพื่อง่ายต่อการตรวจสอบของเพื่อนอาจารย์และสมาชิกครับ

[ca_jaoa]

ใช่ค่ะ แต่กลัวงง เลยตั้งกระทู้ใหม่ค่ะ อยากลบกระทู้เก่าไปเลย แต่ลบไม่เป็นค่ะ

[snasui]

ผมรวมกระทู้ให้เรียบร้อยแล้ว ช่วยแนบไฟล์ Excel ที่เขียน Code ไว้แล้วมาด้วยเพื่อสะดวกในการตอบของเพื่อน ๆ ครับ

[ca_jaoa]

https://www.dropbox.com/s/pm76u6e53g199 ... .xlsx?dl=0

กดลิงค์เข้า excel file ค่ะ

[snasui]

ให้แนบไฟล์มาที่ฟอรัมนี้ อ่านกฎข้อ 4 ด้านบนด้วยครับ

[ca_jaoa]

Plan Template_v01.xlsx

ขอโทษด้วยค่ะ แนบไฟล์มาแล้วค่ะ

[snasui]

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