รบกวนแก้ code vba กดส่งค่าระหว่าง sheet

[Jancha]

การทำงานของ code นี้คือเมื่อมีการคลิก cell ใดๆใน range D9:D(last row) และ E9:E(last row) ใน sheet1 จะส่งค่าใน cell นั้นไปที่ sheet2 ตามพิกัด cell ที่กำหนดไว้ แต่เมื่อมีการเพิ่ม row ยัง sheet1 ก็ต้องมาปรับ range ใน code ตลอดบางทีก็ลืมปรับทำให้ code ไม่ทำงาน อยากรบกวนแก้ไข code ดังกล่าวให้ทำงานโดยอัตโนมัติโดยการเช็ค row ที่เพิ่มขึ้นได้ และรบกวนเช็ค code ว่ามีวิธีที่น่าจะเขียนได้รวบรัดกว่านี้รบกวนปรับให้ด้วยครับ code อยู่ที่ sheet1 private sub

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("D9:D24")) Is Nothing Then
        Sheets("Sheet2").Range("C7").Value = Target.Value
    End If

    If Not Intersect(Target, Range("E9:E24")) Is Nothing Then
        Sheets("Sheet2").Range("C9").Value = Target.Value
    End If
End Sub

[logic]

ลองปรับเป็นแบบนี้ดูครับ

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim rw As Long
    rw = Cells(Rows.Count, 4).End(xlUp).Row
    If Not Intersect(Target, Range("D9:D" & rw)) Is Nothing Then     '// ตรวจสอบการคลิกช่วง cell "D8:Dxxx..
        Sheets("Sheet2").Range("C7").Value = Target.Value         '// ถ้าใช่ให้ส่งค่าใน Cell นั้นไปที่ชีท Sheet2 ที่ "C7"
    End If

    If Not Intersect(Target, Range("E9:E" & rw)) Is Nothing Then     '// ตรวจสอบการคลิกช่วง cell "E8:Exxx.
        Sheets("Sheet2").Range("C9").Value = Target.Value         '// ถ้าใช่ให้ส่งค่าใน Cell นั้นไปที่ชีท Sheet2 ที่ "C9"
    End If
End Sub

มาเชียร์ให้ใส่รุ่นเอ็กเซลล์ ดูโพสต์ของอาจารย์ครับ ~~> คลิก

[Jancha]

ขอบคุณครับคุณ logic ได้ตามที่ต้องการแล้วครับ

[Jancha]

สอบถามเพิ่มเติมครับ การใส่ ' ปิดทำงานของ code ได้เป็นบรรทัดๆ ถ้าต้องการเลือกช่วง code ไม่ให้ทำงานระหว่างบรรทัดใดๆถึงบรรทัดใดๆใช้เครื่องหมายอะไรครับ

[snasui]

คลุม Code แล้วคลิกปุ่ม Comment Block ใน Tools ที่ชื่อว่า Edit ดังภาพครับ

การเปิด Tools เข้าเมนู View > Toolbars > Edit

[Jancha]

ขอบคุณครับ