Snasui Excel Forum

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

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