ต้องการให้ข้อมูลที่เพิ่มเข้ามาเรีนงไปทางขวาครับ

[Jojoemizu]

ขอความช่วยเหลือด้วยครับ คือผมต้องการให้ข้อมูลเรียงไปทางขวา อ่ะ (ตอนนี้เพิ่มข้อมูลแล้วมันลงไปด้านล่าง) และอยากให้ไปเพิ่มใน Sheet2 ครับ โดยเริ่มต้นที่ B2 อ่ะครับ

ตัวอย่างโค๊ด ที่ผมไปหามาได้นะครับ คือจะนำมาประยุกต์ใช้ครับ แต่ไม่รู้ว่าต้องแก้ไขตรงไหน ครับ

Private Sub TextBox1_AfterUpdate()
If Me.TextBox1.Value <> "" Then
Dim irow As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2")
Me.TextBox1.Text = Application.Trim(Me.TextBox1.Text)
'Find first empty row in database
irow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'Copy The Data To The Database
ws.Cells(irow, 1).Value = Me.TextBox1.Value

ws.Cells(irow, 1).Select
Me.TextBox1 = ""

Me.TextBox1.SetFocus
Else
MsgBox "no product", vbCritical
End If
End Sub

[snasui]

ผมไม่สามารถเปิดไฟล์ที่แนบมาได้ครับ นอกจากนี้ควรโพสต์ Code ให้แสดงเป็น Code โดยดูจาก Link นี้ครับ viewtopic.php?f=3&t=1187

การทดสอบ Run Code ให้กดแป้น F8 เพื่อ Run ทีละ Step แล้วแจ้งมาว่า Code ส่วนใดที่เป็นปัญหา ไม่บันทึกข้อมูลไปด้านขวาตามต้องการ

[Jojoemizu]

Code: Select all

Option Explicit
Sub RoundedRectangle1_Click()
Dim s As Range
Dim tg As Range
Dim tg3 As Range
Set s = Worksheets("Sheet1").Range("B1")
Set tg = Worksheets("Sheet2").Range("A365").End(xlUp).Offset(1, 0)
Set tg3 = Worksheets("Sheet3").Range("A365").End(xlUp).Offset(1, 0)
s.Copy

tg.PasteSpecial xlPasteValues
tg3.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

[snasui]

ผมไม่สามารถเปิดไฟล์ที่แนบมาได้

หากสมาชิกท่านใดสะดวก ช่วยทดสอบว่าเปิดได้หรือไม่แล้วช่วยแจ้งด้วย ขอบคุณครับ

[tupthai]

เปิดfileไม่ได้เหมือนกันครับ

[snasui]

ขอบคุณที่แจ้งผลครับ

คุณ Jojoemizu ลองพยายามแนบมาใหม่อีกรอบครับ

[Jojoemizu]

ไม่ทราบว่าท่านใดพอมีลิงค์ให้ผมได้ศึกษาการ รับข้อมูลมา และก็ไปเพิ่มอัตโนมัติ จากปกติจะไปเพิ่มต่อท้ายในแนวนอน
เช่น
นาย A 15
นาย B 20
แต่ผมต้องการให้ข้อมูลที่เพิ่มเข้ามาเป็น
นาย A 15 นาย B 20 ประมาณนี้อ่ะครับ
คือผมก็แนบไฟล์ไปปกติแล้ว แต่ไม่รู้ว่าทำไมมันถึงไม่สามารถเปิดได้อ่ะครับ

ผมพยายามค้นหามาสองวันแล้ว ก็ยังไม่สามารถทำได้เลยครับ ได้โปรดแนะนำ ด้วยครับ

[snasui]

ผมไม่สามารถเปิดไฟล์ได้เช่นเดิม

สำหรับการ Copy ไปวางด้านขวาลองดูตัวอย่าง Code ด้านล่างครับ

Code: Select all

Set tg = Worksheets("Sheet2").Range("A365").End(xlToLeft).Offset(0, 1)
Set tg3 = Worksheets("Sheet3").Range("A365").End(xlToLeft).Offset(0, 1)

[Jojoemizu]

Code: Select all

Option Explicit
Sub RoundedRectangle1_Click()
Dim s As Range
Dim tg As Range
'Dim tg3 As Range
Set s = Worksheets("Sheet1").Range("B1:C7")
Set tg = Worksheets("Sheet2").Cells(1, Cells.Columns.Count).End(xlToLeft).Offset(0, 1)
'Set tg3 = Worksheets("Sheet3").Range("A1").End(xlToLeft).Offset(0, 1)
s.Copy

tg.PasteSpecial xlPasteValues
'tg3.PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

ขอบคุณทุกท่านที่ที่ช่วยเหลือนะครับ ผมทำได้แล้วครับ ตามข้างบนเลยครับ
ใช้ในการดู Trend ในแต่ละเดือนหรือปี เผื่อผู้ที่สนใจนำไปประยุกต์ใช้กันนะครับ
สามารถทำได้ทั้งแนวนอนและแนวตั้งนะครับ