VBA - Copy cell A if cell AE contains 'YES'

[matthewbchater]

I am trying to create a VB Button that will copy the contents of all worksheets' column A of any rows where the contents of Column AE contain 'YES'. Please see attached excel file.

However, the VB script is pulling back some odd results (e.g. Acrington Stanley) where rows are being copied even though there is no contents in row AE.

Can anyone help?

[Mumps1]

Once you copy the row, what do you want to do with it?

[matthewbchater]

Once you copy the row, what do you want to do with it?

Hi. Have a look at the code already written. I want to copy the contents of the cell in Column A to the Sheet ‘Active Pursuits’. I need to form a list of ALL the clubs that have YES in cell AE but only wish to copy over the contents of column A for each of these.

[Mumps1]

Try:

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim sh As Worksheet
    Dim bottomE As Long
    Application.ScreenUpdating = False
    Set sh = Sheets("Active Pursuits")
    For Each ws In Worksheets
        If ws.Name <> "Active Pursuits" And ws.Name <> "DO NOT USE" And ws.Name <> "Non-Affiliated Stadia and Arena" Then
            If WorksheetFunction.CountIf(ws.Range("AE:AE"), "Yes") > 0 Then
                bottomE = ws.Range("E" & Rows.Count).End(xlUp).Row
                ws.Range("A1:AM" & bottomE).AutoFilter Field:=31, Criteria1:="Yes"
                ws.Range("A4:A" & bottomE).SpecialCells(xlCellTypeVisible).Copy
                sh.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                If ws.FilterMode Then ws.ShowAllData
            End If
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

[matthewbchater]

I get the following error: Run-time error '1004': we can't do that to a merged cell.

The debug takes me to code line: ws.Range("A4:A" & bottomE).SpecialCells(xlCellTypeVisible).Copy

[davesexcel]

Possibly, an if statement would work.,
for example.

  x = Application.WorksheetFunction.CountIf(ws.Range("AE:AE"), "YES")
                If x > 0 Then
                .Offset(1, -30).Copy
                sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
                End If

[davesexcel]

I thought I already answered this,

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim sh As Worksheet

    Application.ScreenUpdating = False

    Set sh = Sheets("Active Pursuits")

    On Error Resume Next
    For Each ws In Worksheets
        If ws.Name <> "Active Pursuits" And ws.Name <> "DO NOT USE" And ws.Name <> "Non-Affiliated Stadia and Arena" Then
            With ws.Range("AE1", ws.Range("AE" & ws.Rows.Count).End(xlUp))
                .AutoFilter 1, "YES"
                x = Application.WorksheetFunction.CountIf(ws.Range("AE:AE"), "YES")
                If x > 0 Then
                    .Offset(1, -30).Copy
                    sh.Range("A" & Rows.Count).End(3)(2).PasteSpecial xlPasteValues
                End If

                .AutoFilter
            End With
        End If
    Next ws

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

[Mumps1]

The macro doesn't return an error when I run it on the file you posted in Post #1. Click here to download your file and give it a try.

[matthewbchater]

It still does not copy across every instance where AE = YES. I am also getting some instances where the AE = empty and the data in column A is being copied. If you insert data into approx 10 rows in column A and Mix column AE with YES and NO, you will see the issue. This is occuring across all worksheets.

Thanks for all your help.

[Mumps1]

I added a few Yes's in AE of Football - Premier League and Football - Championship and all worked properly. Have a look at the Pursuits sheet. Click here.