Snasui Excel Forum

Code: Select all

Sub PasteData()
    Dim rs As Range, rt As Range
    Dim r As Range
    Set rs = Worksheets("Temp").Range("E2:E24")
    For Each r In rs
        If r <> 0 Then
            'กำหนดข้อมูลปลายทางที่จะนำค่ามาวาง
            Set rt = Worksheets("Historical").Range("B" & Rows.Count) _
                 .End(xlUp).Offset(1, 0)
            'กำหนดข้อมูลต้นทาง และ resize เพื่อเปลี่ยนขนาดความสูงเป็น 1 บรรทัดความกว้าง 9 คอลัมน์
            r.Offset(0, -4).Resize(1, 9).Copy
            rt.PasteSpecial xlPasteValues
        End If
    Next r
    Application.CutCopyMode = False
    MsgBox "Finish."
End Sub