macro autofilter skip if blank

[phairplay]

I'm working on a macro that filters by a name then copies the data into a new workbook.

Sub copied()
'
' copied Macro
' Macro recorded 17/11/2011 by 
    Application.ScreenUpdating = False
    Dim Nm As String
    
    Set bk = ActiveWorkbook 'makes this the only active sheet so you can return to it
    Nm = InputBox("Enter the Name of the person to search and copy")
    Sheets("PL").Select
    Rows("1:1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=Nm
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.SaveAs Filename:="C:\Users\" & _
        Application.UserName & _
        "\Desktop\Test.xlsx", _
                FileFormat:=xlWorkbookDefault, CreateBackup:=False
' now do the same for the next sheet
 bk.Activate 'returns the the active workbook
     Sheets("PI").Select
     Rows("1:1").Select
     Selection.AutoFilter
     Selection.AutoFilter Field:=1, Criteria1:=Nm
     Range("A2").Select
     Range(Selection, Selection.End(xlDown)).Select
     Range(Selection, Selection.End(xlToRight)).Select
     Selection.copy
     Windows("Test.xlsx").Activate
     Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' now do the same for the next sheet
            bk.Activate 'returns the the active workbook
     Sheets("UE").Select
     Rows("1:1").Select
     Selection.AutoFilter
     Selection.AutoFilter Field:=1, Criteria1:=Nm
     Range("A2").Select
     Range(Selection, Selection.End(xlDown)).Select
     Range(Selection, Selection.End(xlToRight)).Select
     Selection.copy
     Windows("Test.xlsx").Activate
      Sheets("Sheet3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.ScreenUpdating = True
End Sub

my problem is if one of the tabs = blank data excel seems to crash. Is there anyway to skip part of the macro if no data is found in the filter?

 

[JoeMo]

Untested so this may need some tweaking (additions in bold red):

Sub copied()
'
' copied Macro
' Macro recorded 17/11/2011 by
    Application.ScreenUpdating = False
    Dim Nm As String
    
    Set bk = ActiveWorkbook 'makes this the only active sheet so you can return to it
    Nm = InputBox("Enter the Name of the person to search and copy")
    Sheets("PL").Select
    Rows("1:1").Select
    If WorksheetFunction.CountIf(Selection.Columns(1), Nm) = 0 Then GoTo nextSheet
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:=Nm
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Workbooks.Add
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveWorkbook.SaveAs Filename:="C:\Users\" & _
        Application.UserName & _
        "\Desktop\Test.xlsx", _
                FileFormat:=xlWorkbookDefault, CreateBackup:=False
' now do the same for the next sheet
nextSheet:
 bk.Activate 'returns the the active workbook
     Sheets("PI").Select
     Rows("1:1").Select
If WorksheetFunction.CountIf(Selection.Columns(1), Nm) = 0 Then GoTo nextSheet2
     Selection.AutoFilter
     Selection.AutoFilter Field:=1, Criteria1:=Nm
     Range("A2").Select
     Range(Selection, Selection.End(xlDown)).Select
     Range(Selection, Selection.End(xlToRight)).Select
     Selection.Copy
     Windows("Test.xlsx").Activate
     Sheets("Sheet2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
' now do the same for the next sheet
nextSheet2:
            bk.Activate 'returns the the active workbook
     Sheets("UE").Select
     Rows("1:1").Select
If WorksheetFunction.CountIf(Selection.Columns(1), Nm) = 0 Then exit sub
     Selection.AutoFilter
     Selection.AutoFilter Field:=1, Criteria1:=Nm
     Range("A2").Select
     Range(Selection, Selection.End(xlDown)).Select
     Range(Selection, Selection.End(xlToRight)).Select
     Selection.Copy
     Windows("Test.xlsx").Activate
      Sheets("Sheet3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            Application.ScreenUpdating = True
End Sub

 

[phairplay]

thats great many thanks