Excel Forum

Code: Select all

Sub ShiftDataDown()
With Worksheets("Sheet1")
    .Range(.Range("A3"), .Range("C65536").End(xlUp)).Copy
    .Range("A4").PasteSpecial xlPasteValues
    .Range("A2:C2").Copy
    .Range("A3").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
MsgBox "Paste Finish"
End Sub

Code: Select all

Sub ShiftDataDown() 'ชื่อ Procedure
With Worksheets("Sheet1") 'ที่ Sheet1
    .Range(.Range("A3"), .Range("C65536").End(xlUp)).Copy 'ให้ทำการ Copy ช่วงเซลล์ตั้งแต่ A3 จนถึงเซลล์ C ตัวท้ายสุดที่มีข้อมูล
    .Range("A4").PasteSpecial xlPasteValues 'นำมาวางเฉพาะ ค่า (ไม่เอารูปแบบ ไม่เอาสูตร) ที่ A4
    .Range("A2:C2").Copy 'Copy A2:C2
    .Range("A3").PasteSpecial xlPasteValues ' นำมาวางเฉพาะ ค่า (ไม่เอารูปแบบ ไม่เอาสูตร) ที่ A3
End With 'ปิดการทำการกับ Sheet1
Application.CutCopyMode = False 'ปิดการทำงานกับการ Copy --> เหมือนการกด esc
MsgBox "Paste Finish" 'กำหนดให้มีกล่องข้อความแ้จ้งว่าทำการวางข้อมูลเรียบร้อยแล้ว
End Sub 'จบ Procedure

Code: Select all

Option Explicit

Sub PasteData()
Dim i As Integer, r As Range
Dim rSource As Range, rTarget As Range
Dim rTarget1 As Range, rTarget2 As Range
For Each r In Worksheets("สารบัญ").Range("A3:A16")
    If r <> "" Then
        i = i + 1
    End If
Next r
With Worksheets("สารบัญ")
    Set rSource = .Range(.Range("H3"), .Range("A" & 3 + i - 1))
    Set rTarget = .Range(.Range("H20"), .Range("A65536").End(xlUp))
    Set rTarget1 = .Range("A20").Offset(i, 0)
    Set rTarget2 = .Range("A20")
End With
rTarget.Copy
rTarget1.PasteSpecial xlPasteValues
rSource.Copy
rTarget2.PasteSpecial xlPasteValues
Application.CutCopyMode = False
MsgBox "Paste Finish."
End Sub

Code: Select all

Option Explicit

Sub ShiftDataDown()
With Worksheets("สารบัญ")
    .Range(.Range("A19"), .Range("A65536").End(xlUp).Offset(0, 7)).Copy
    .Range("A20").PasteSpecial xlPasteValues
    .Range("A18:H18").Copy
    .Range("A19").PasteSpecial xlPasteValues
End With
Application.CutCopyMode = False
MsgBox "Paste Finish"
End Sub