Snasui Excel Forum

ขอบคุณครับ

:D ผมทดสอบแล้วไม่พบปัญหาที่แจ้งมาครับ ช่วย Run ทีละ Step (ไปที่ VBE แล้วเลือก Code ที่ต้องการแล้วกดแป้น F8 ซ้ำ ๆ) แล้วจับภาพมาให้ดูว่า Error ตรงบรรทัดไหนของ Code

ในsheet 1 เมื่อทำการเลือกสารที่ต้องการปรากฏว่าโปรแกรมเตือนว่า complie error : end if without blok if

Sub MoveData()
    Sheets("Sheet1").Range("D2:D6").ClearContents
    If Sheets("Sheet1").Range("F2") = "oxygen" Then
        Sheets("oxygen").Range("R8:R13").Copy
        Sheets("Sheet1").Range("D2").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
    
    Else
    
        Sheets("hydrogen").Range("R8:R13").Copy
        Sheets("Sheet1").Range("D2").PasteSpecial (xlPasteValues)
        Application.CutCopyMode = False
    
    End If


End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("F2")) Is Nothing Then
    Call MoveData
    
    End If
End Sub

:D ลองใช้โค๊ดนี้ดูครับ

สร้างโมดูล 1 โมดูล แล้วใช้โค๊ดนี้ดูครับ

[code]Sub MoveData()
Sheets("Sheet1").Range("D2:D6").ClearContents
If Sheets("Sheet1").Range("F2") = "oxygen" Then
Sheets("oxygen").Range("R8:R13").Copy
Sheets("Sheet1").Range("D2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

Else

Sheets("hydrogen").Range("R8:R13").Copy
Sheets("Sheet1").Range("D2").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False

End If


End Sub[/code]

ในชีท Sheet1 วางโค๊ดนี้ครับ
[code]Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("F2")) Is Nothing Then
Call MoveData

End If
End Sub
[/code]

ในเอกสารhydrogen กับ oxygen ผมใส่คำสั่งmacro ไว้และในcell h2 ผมทำ pick form drop down listไว้ คือผมอยากทำlink
เช่น ถ้าผมเลือกhydrogen ให้run macro จากsheet hydrogen แล้วทำการส่งค่าจากsheet hydrogen จาก cell r8-r13 ครับไปยังในsheet1ที่cell d2-d6ครับ