Create New Dynamic Sheet based on Column

Question

I'm trying to make a new sheet that has just the advertisers that want to advertise based on main contact sheet.

My sheet is setup like this:

Customer   Add1   Add2   City/State/Zip   Mailed   Phone   Called   Advertising

Where the advertising column is either Y or N. What I want to do is have a new sheet that contains every advertiser that has ay in their advertising column.

I have gotten it to display the customer in the new sheet if sheet 1 contains a Y in the advertising column but I'd have to drag the formula down and then have a ton of blank spaces for the rows that have Ns instead of Ys. I'm a novice at VBA and don't even know where to start if that's how I will have to do it.

I'm trying to keep track of what kind of ads they want on a separate sheet so I don't have any more columns on my main sheet and cluttering it up. If it comes down to it I guess I can write a C++ program to do it but I'd like to keep it in excel.

I've looked at some of the code on here but I have no clue how to manipulate it to what I need.

EDIT This is what I have working for me right now, I combined two of the solutions into one:

Sub AdvertisingFilter()
Dim Wb As Workbook
Dim Ws As Worksheet
Dim Wst
Dim rN As Long, c As Long, counter As Long

Set Wb = ThisWorkbook

If e("Advertising") = False Then
    With Wb.Sheets
       .Add().Name = "Advertising"
    End With
End If

Set Ws = Wb.Worksheets("Advertising")
Set Wst = Wb.Worksheets("Customers")

Ws.Cells.Clear

counter = 2 'Assuming you have a Header in your second sheet

With Wst

rN = .Cells(.Rows.Count, 1).End(xlUp).Row 'find last row

For c = 2 To rN

    If .Cells(c, 9).Value = "Y" Then 'Copy only if the value in column I is "Y"

        .Rows(c).Columns(1).Copy
        Ws.Rows(counter).Columns(1).PasteSpecial xlPasteValues
        counter = counter + 1
    End If
Next

End With

End Sub

Function e(n As String) As Boolean

 Dim Wss As Worksheet

  e = False
  For Each Wss In Worksheets
    If n = Wss.Name Then
      e = True
      Exit Function
    End If
  Next Wss
End Function

Answer 1

Add and run this macro:

Sub CreateAdSheet()
    With Sheets("Main Contact").UsedRange
       .AutoFilter 8, "Y" ' <~~ Assumed advertising is column 8 (H)
       .Copy Sheets.Add().Cells(2, 1)
       .AutoFilter
    End With
End Sub

Answer 2

Below code will check for sheet Name "Adversting" if not it will create a new one. It will copy the autofilter values ( "Y" on Advertising column) and paste it in the advertising sheet

    Option Explicit

    Sub Worksheetfilter()

    Dim c As Variant
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim WsPaste As Worksheet
    Dim Columnaddress As Long
    Dim Rowaddress As Long
    Dim Rng As Range
    Dim Rngcopy As Range
    Dim Countws As Long

    'On Error Resume Next
    Set Wb = ThisWorkbook

    Set Ws = Wb.Worksheets("sheet1")

    With Ws.UsedRange
        Set c = .Find("Advertising", LookIn:=xlValues)
        If Not c Is Nothing Then
            Columnaddress = c.Column
            Rowaddress = c.Row
       End If
    End With


    Set Rng = Ws.Columns(Columnaddress)

    Countws = WorksheetFunction.CountIf(Rng, "Y")


    If Countws >= 1 Then

    If e("Adversting") = False Then
        With Wb.Sheets
           .Add().Name = "Adversting"
        End With
    End If

    Set WsPaste = Wb.Worksheets("Adversting")

    WsPaste.Cells.Clear

    Ws.AutoFilterMode = False 

    'Ws.Rows(Rowaddress).AutoFilter Field:=Columnaddress, Criteria1:="Y"

Ws.UsedRange.Rows(Rowaddress).AutoFilter Field:=Columnaddress, Criteria1:="Y"


    Set Rngcopy = Ws.UsedRange.SpecialCells(xlCellTypeVisible)


    Rngcopy.Copy

    WsPaste.Cells(1, 1).PasteSpecial xlValues

    Application.CutCopyMode = False
    Application.CutCopyMode = True

    Ws.AutoFilterMode = False
    End If

    End Sub
    Function e(n As String) As Boolean

     Dim Wss As Worksheet

      e = False
      For Each Wss In Worksheets
        If n = Wss.Name Then
          e = True
          Exit Function
        End If
      Next Wss
    End Function

Answer 3

I hope you know how to open VBA and insert a new module. Paste this in the module:

Sub test()

Dim ws As Worksheet
Dim rN As Long, c As Long, counter As Long

Set ws = Worksheets(2) 'Change the 2 to the index where the sheet is located, i.e. if it is located in 4th position,
                       'then change the 2 to 4
counter = 2 'Assuming you have a Header in your second sheet

With ActiveSheet

rN = .Cells(.Rows.Count, 1).End(xlUp).Row 'find last row

For c = 2 To rN

    If .Cells(c, 8).Value = "Y" Then 'Copy only if the value in column H is "Y"

        .Rows(c).EntireRow.Copy

        ws.Rows(counter).EntireRow.PasteSpecial xlPasteValues
        counter = counter + 1
    End If
Next

End With

End Sub