รบกวนอาจารย์หรือท่านผู้รู้ ช่วยปรับVBA ในการบันทึกข้อมูล

[myjrcenter]

รายการโอนเข้า.xlsm

รบกวนช่วยปรับVBA ให้หน่อยครับ ต้องการส่งค่าที่ sheet"ทำรายการ" B3,B5,C2,B4 ไปบันทึกที่ sheet"save" คอลัมน์ a,b,c,d ตามลำดับ เมื่อมีรายการใหม่ก็ให้ต่อในแถวที่ว่างถัดไป

Code: Select all

Sub Save()
    Sheets("ทำรายการ").Range("B3").Copy
    With Sheets("Save")
        .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
   Sheets("ทำรายการ").Range("B5").Copy
    With Sheets("Save")
        .Range("B" & .Range("B" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
       Sheets("ทำรายการ").Range("B4").Copy
    With Sheets("Save")
        .Range("D" & .Range("D" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
     Sheets("ทำรายการ").Range("C2").Copy
    With Sheets("Save")
        .Range("C" & .Range("C" & Rows.Count).End(xlUp).Row).Offset(1, 0).PasteSpecial xlPasteValues
    End With
    Range("B3").Select
ActiveWorkbook.Save
End Sub  

ทำให้สั้นลงกว่านี้ได้มั้ยครับ ขอบคุณครับ

[puriwutpokin]

กรุณาแนบไฟล์ ดังกล่าวมาด้วย ครับจะได้เข้าใจตรงกันครับ

[myjrcenter]

ขอโทษด้วยครับครั้งแรกลืมดูว่าไฟล์แนบไม่ขึ้น

[puriwutpokin]

ปรับตามนี้ดูครับ

Code: Select all

Sub Save()
    Dim wsSource As Worksheet
    Dim wsTarget As Worksheet
    Dim sourceRange As Variant
    Dim targetColumns As Variant
    Dim i As Integer
    Set wsSource = Sheets("ทำรายการ")
    Set wsTarget = Sheets("Save")
    sourceRange = Array("B3", "B5", "B4", "C2")
    targetColumns = Array("A", "B", "D", "C")
    For i = LBound(sourceRange) To UBound(sourceRange)
        wsSource.Range(sourceRange(i)).Copy
        wsTarget.Range(targetColumns(i) & wsTarget.Cells(Rows.Count, targetColumns(i)).End(xlUp).Row + 1).PasteSpecial xlPasteValues
    Next i
    Application.CutCopyMode = False
    wsSource.Range("B3").Select
    ActiveWorkbook.Save
End Sub

[myjrcenter]

puriwutpokin ใช้ได้ครับ ขอบคุณมากครับ