Excel Forum

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  

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