Help with VBA code to filter, copy and paste in another worksheet

[kevinh2320]

I need some help with the code below. On my "Leases" worksheet I have data in columns A through F. I am filtering on the word "Question" in column F then coping those rows into the first available row on my "Question" work sheet columns A through F. The code works fine provided the word "Question" is somewhere on the sheet in column F. However, in cases where there is no "Question" entry the code fails because there isn't anything to paste. I think I need to add or modify the "If Statement" but, not sure how to do that.


Also, I'm sure there are other ways to tighten up this code. Would appreciate any help and suggestions.


Sub MoveTest()


'Move rows from Permit worksheet that contain the word "Question" - column F
Worksheets("Permits").Activate
With ActiveSheet
.AutoFilterMode = False
If Application.CountIf(.Range("F:F"), "*Question*") > 0 Then
With Range("F1", Range("F" & Rows.Count).End(xlUp))
.AutoFilter 1, "*Question*"
.Offset(1).SpecialCells(12).EntireRow.Copy
End With
End If
.AutoFilterMode = False
End With
'Application.CutCopyMode = False


'Go to Questions worksheet and paste records in first available row
Worksheets("Question").Activate
Range("A1048576").Select
Selection.End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Selection.Interior.Color = xlNone
Range("A1").Select


'Release copy mode from Permits worksheet
Worksheets("Permits").Activate
Application.CutCopyMode = False


End Sub

Thank you Thank you

 

[JLGWhiz]

How about something like this:

If Application.CountIf(.Range("F:F"), "*Question*") > 0 Then
    With Range("F1", Range("F" & Rows.Count).End(xlUp))
        .AutoFilter 1, "*Question*"
        .Offset(1).SpecialCells(12).EntireRow.Copy
    End With
Else
    Beep
    MsgBox "Question not found", vbInformation, "NO MATCH"
    Exit Sub
End If