Code VB เติมข้อมูลลงในเซลที่ต้องการตามเงื่อนไข

[tigerwit]

จากไฟล์ที่แนบมา
ต้องการให้ Code นี้ ใช้งานได้กับทุกชีท
ต้องปรับแก้อย่างไรครับ
ตอนนี้ใช้ได้เฉพาะปุ่มที่อยู่ในชีท Sheet1 ส่วนปุ่มที่อยู่ในชีท Sheet2 มีปัญหาครับ

Code: Select all

Sub FillStatus()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    With Worksheets("Sheet1")
        Set r = .Range("A1")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
          lastRow = r.Offset(i - 1, 0).Row
            If Selection.Row <= lastRow Then
            Worksheets("Sheet1").Range("B:B").ClearContents
            Worksheets("Sheet1").Range("B1").Select
            .Range(Selection, .Cells(lastRow, Selection.Column)).Value = "เรียน"
            If Selection.Offset(0, 1).Locked Then Exit Sub
            Selection.Offset(0, 1).Select
        End If
        End With
End Sub

[snasui]

กรุณาแนบไฟล์ตัวอย่าง พร้อมชี้ให้เห็นว่าปัญหาคืออะไร ต้องการคำตอบเป็นอย่างไร จะได้เข้าใจตรงกันครับ

[tigerwit]

จากไฟล์ที่แนบมาครับ
ในชีท sheet1 เมื่อกดปุ่ม กำหนดสถานะนักเรียน เซลในคลอลัมน์ B จะมีข้อความว่า เรียน แสดงขึ้น
โดยจะไม่เกินแถวที่มีข้อมูลในคลอลัมน์ A (ถ้าคลอลัมน์ A มี ข้อมูลตั้งแต่ A1-A13 คำว่า เรียน จะแสดงใน B1-B13
โค๊ดด้านล่างนี้ ถ้าสั่งในขณะอยู่ที่ Sheet1 จะสามารถทำงานได้ แต่ถ้า อยู่ใน Sheet2 จะไม่สามารถทำงานได้
ต้องปรับแก้อย่างไร จึงจะสามารถทำงานได้ ไม่ว่า จะอยู่ในชีทใดก็ตาม

Code: Select all

Sub FillStatus()
    Dim lastRow As Long
    Dim i As Long, r As Range, j As Long
    With Worksheets("Sheet1")
        Set r = .Range("A1")
        Do While r.Offset(i, 0).Value <> ""
            i = i + 1
        Loop
          lastRow = r.Offset(i - 1, 0).Row
            If Selection.Row <= lastRow Then
            Worksheets("Sheet1").Range("B:B").ClearContents
            Worksheets("Sheet1").Range("B1").Select
            .Range(Selection, .Cells(lastRow, Selection.Column)).Value = "เรียน"
            If Selection.Offset(0, 1).Locked Then Exit Sub
            Selection.Offset(0, 1).Select
        End If
        End With
End Sub

[puriwutpokin]

เปลี่ยน

Code: Select all

Worksheets("Sheet1")

เป็น

Code: Select all

ActiveSheet

ทุกตำแหน่งครับ