บันทึกข้อมูลต่อแถวครับ

[san02551]

Code: Select all

Sub กล่องข้อความ1_คลิก()
Range("a2:d8").Select
    Selection.Copy
    Sheets("2").Select
    lastrow = Application.Match(9.99999999999999E+307, Sheets("2").Range("a:a")) + 1
    Range("a" & lastrow).Select
    Selection.PasteSpecial xlPasteValues
    Sheets("1").Select
    Range("a2:d8").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("a2").Select
End Sub

[pongpang]

ลองปรับปรุงเป็น ดังนี้ครับ

Code: Select all

Sub กล่องข้อความ1_คลิก()
Application.ScreenUpdating = False
  Sheets("1").Range("A2:d8").Copy
            Sheets("2").Range("A65536").End(xlUp).Offset(1, 0) _
                .PasteSpecial xlPasteValues
    Sheets("1").Select
    Range("a2:d8").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("a2").Select
    Application.ScreenUpdating = False
End Sub

[pongpang]

ลองปรับปรุงเป็น ดังนี้ครับ

Code: Select all

Sub กล่องข้อความ1_คลิก()
Application.ScreenUpdating = False
  Sheets("1").Range("A2:d8").Copy
            Sheets("2").Range("A65536").End(xlUp).Offset(1, 0) _
                .PasteSpecial xlPasteValues
    Sheets("1").Select
    Range("a2:d8").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("a2").Select
    Application.ScreenUpdating = False
End Sub

ขอโทษครับ เมื่อดู Code แล้ว ขอให้แก้เป็น

Code: Select all

Sub กล่องข้อความ1_คลิก()
Application.ScreenUpdating = False
  Sheets("1").Range("A2:d8").Copy
            Sheets("2").Range("A65536").End(xlUp).Offset(1, 0) _
                .PasteSpecial xlPasteValues
    Sheets("1").Select
    Range("a2:d8").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("a2").Select
    Application.ScreenUpdating = True
End Sub

[san02551]

กรณีข้อมูลมี 3 แถว มันจะเว้นแถว ครับ เช่น ข้อมูลชุดที่ 1 มี 3 แถว ก็จะเว้นแถวไม่มีข้อมูล มันบันทึกไม่ต่อแถวกันครับ

[snasui]

ตัวอย่างการปรับ Code ครับ

Code: Select all

Sub AbcdEfGh()
    Range("a2:d8").Select
    Selection.Copy
    Sheets("2").Select
    If Range("a1") = "" Then
        lastrow = 1
    Else
        lastrow = Range("a100000").End(xlUp).Offset(1, 0).Row
    End If
    Range("a" & lastrow).Select
    Selection.PasteSpecial xlPasteValues
    Sheets("1").Select
    Range("a2:d8").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("a2").Select
End Sub

[san02551]

เรียนถามครับ
จากไฟล์แนบ ผมต้องการบันทึกข้อมูลจาก edit ช่วง h3:l43 ไปบันทึกข้อมูลที่ Alldata โดยเริ่มที่ B ต่อแถวไปเรื่อยๆ ครับ เพราะที่บันทึกข้อมูล จะบันทึกเป็นชุดครับ

[san02551]

ข้อมูลจะบันทึกเป็นชุด ๆละ 30 แถว ที่ผมต้องการ คือให้บันทึกที่ Alldata เป็นการบันทึกต่อ จากข้อมูลเดิม ครับ

[bank9597]

ผมไม่เห็นโค๊ดที่เขียนไว้ครับ

ต้องเขียนมาเองก่อนครับ ในเบื้องต้น

[san02551]

Code: Select all

Sub TextBox2_Click()
    Range("h3:l43").Select
    Selection.Copy
    Sheets("Alldata").Select
    If Range("a1") = "" Then
        lastrow = 1
    Else
        lastrow = Range("a100000").End(xlUp).Offset(1, 0).Row
    End If
    Range("a" & lastrow).Select
    Selection.PasteSpecial xlPasteValues
    Sheets("edit").Select
    Range("i3:l43").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("i3").Select
End Sub

[san02551]

ขอโทษ ครับ แนบไฟล์ที่มีโค้ด มาใหม่แล้วครับ

[bank9597]

ลองปรับโค๊ดเป็น

Code: Select all

Public Sub CopyAndPaste()

    Dim FormWs As Worksheet
    Dim DataWs As Worksheet
    Dim lngLastRow As Long
    
    Set FormWs = Sheets("Edit")
    Set DataWs = Sheets("AllData")
    
    lngLastRow = FormWs.Range("I" & Rows.Count).End(xlUp).Row
    
    FormWs.Range("H3:L" & lngLastRow).Copy
    
    lngLastRow = DataWs.Range("B" & Rows.Count).End(xlUp).Row
    
    DataWs.Range("B" & lngLastRow).Offset(1, 0).PasteSpecial xlPasteValues
    
    Application.CutCopyMode = False
    Set FormWs = Nothing
    Set DataWs = Nothing
    
End Sub

[san02551]

ขอบคุณครับ ทำได้แล้วครับ