Code ไม่รัน

[rich37]

รบกวนช่วยดูหน่อยครับว่ามันผิดตรงไหนติดตรงคำสั่งลบแถว

Code: Select all

Private Sub CommandButton1_Click()
    On Error Resume Next
        If Err.Number = 1004 Then
        MsgBox "ไม่มีครบนัดอย่ากดเล่นครับ"
        End If
        If Worksheets("Data").Range("A3") = "" Then
            MsgBox "คุณไม่มีข้อมูลที่จะส่งไป กรุณากรอกข้อมูลก่อน", vbExclamation, "กรุณากรอกข้อมูล"
        Else
        ActiveSheet.Unprotect  
        Selection.AutoFilter      
        ActiveSheet.Range("$A$2:$M$202").AutoFilter Field:=12, Criteria1:="ครบกำหนด"
        Sheets("Data").Range("Source").Copy Sheets("Report").Range("Target")
        Range("Source").ClearContents           
        ActiveSheet.Range("$A$2:$M$202").AutoFilter Field:=12
        Sheets("Data").Range("Source").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 'คำสั่งลบแถวที่มีปัญหา
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True 
        ActiveWorkbook.Save        
        Application.DisplayAlerts = False
        Application.Quit        
        End If
End Sub

[parakorn]

Code: Select all

Sheets("Data").Range("Source").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

ลองแก้เป็น

Code: Select all

Sheets("Data").Range("Source").Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp

[rich37]

Code: Select all

Sheets("Data").Range("Source").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

ลองแก้เป็น

Code: Select all

Sheets("Data").Range("Source").Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.Delete Shift:=xlUp

ขอบคุณครับ ลองแล้วมันลบได้แต่แถวมันไม่จัดเรียงครับ ตามรูปครับ

[rich37]

ตอนนี้แก้ไขได้เรียบร้อย แค่ไปแก้ในตัว Excel ในส่วนของการกำหนด ("Source") ให้ไม่ไปเกี่ยวกับคอลัมน์ L =OFFSET(Data!$A$2,1,0,202,11)