Copy, to another sheet, a range of cells in a row if one cell has certain text.

[danj4fsu]

I hope I explain this so everyone understands. I have included a screenshot for some clarification. For every instance of "held" in column F, i want the corresponding cells A-E to be copied to another sheet.

https://www.dropbox.com/s/k7mbt18510m766u/inside sales 2.JPG?dl=0

TIA

 

[mumps]

Instead of a screen shot, can you upload a copy of your file? De-sensitize the data if necessary. This would make it easier to test a possible solution.

 

[danj4fsu]

Instead of a screen shot, can you upload a copy of your file? De-sensitize the data if necessary. This would make it easier to test a possible solution.

Done, previous link should have the excel file. All info is test info.

 

[mumps]

The reason you were getting the error is because only Jan. had data starting in row 13. The other months did not and thus the error "No cells were found". This revised macro checks to make sure that each sheet has at least one occurrence of "held" in column F. If it doesn't have at least one occurrence, then that sheet is skipped.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.Name <> "Held Appts 4 Submission" Then
            LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
            If WorksheetFunction.CountIf(ws.Range("F13:F" & LastRow), "held") > 0 Then
                ws.Range("A11:F" & LastRow).AutoFilter Field:=6, Criteria1:="held"
                ws.Range("A13:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Held Appts 4 Submission").Cells(Sheets("Held Appts 4 Submission").Rows.Count, "A").End(xlUp).Offset(1, 0)
                If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

 

[danj4fsu]

The reason you were getting the error is because only Jan. had data starting in row 13. The other months did not and thus the error "No cells were found". This revised macro checks to make sure that each sheet has at least one occurrence of "held" in column F. If it doesn't have at least one occurrence, then that sheet is skipped.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.Name <> "Held Appts 4 Submission" Then
            LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
            If WorksheetFunction.CountIf(ws.Range("F13:F" & LastRow), "held") > 0 Then
                ws.Range("A11:F" & LastRow).AutoFilter Field:=6, Criteria1:="held"
                ws.Range("A13:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Held Appts 4 Submission").Cells(Sheets("Held Appts 4 Submission").Rows.Count, "A").End(xlUp).Offset(1, 0)
                If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
            End If
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

Awesome, perfect! Thank you!

 

[mumps]

My pleasure.

 

[danj4fsu]

So out of no where this macro has started giving me "Run-time error '1004': AutoFilter method of Range class failed.

I have included the spreadsheet and a screen shot of the highlighted error from Visual Basic here.

 

[mumps]

Try this macro:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim ws As Worksheet
    Sheets("Held Appts 4 Submission").UsedRange.Offset(1, 0).ClearContents
    For Each ws In Sheets
        LastRow = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
        If WorksheetFunction.CountIf(ws.Range("F13:F" & LastRow), "Held") > 0 Then
            ws.Range("A13:F" & LastRow).AutoFilter Field:=6, Criteria1:="Held"
            ws.Range("A15:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Held Appts 4 Submission").Cells(Sheets("Held Appts 4 Submission").Rows.Count, "A").End(xlUp).Offset(1, 0)
            If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

You have 2 macros with the same name. Either re-name or delete the macro in Module1 or delete Module1 entirely.

 

[danj4fsu]

Still getting same error. Deleted both modules, and then created a new one with the referred to code. I have re-uploaded the doc here with the updates I tried.

Try this macro:

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    Dim ws As Worksheet
    Sheets("Held Appts 4 Submission").UsedRange.Offset(1, 0).ClearContents
    For Each ws In Sheets
        LastRow = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
        If WorksheetFunction.CountIf(ws.Range("F13:F" & LastRow), "Held") > 0 Then
            ws.Range("A13:F" & LastRow).AutoFilter Field:=6, Criteria1:="Held"
            ws.Range("A15:E" & LastRow).SpecialCells(xlCellTypeVisible).Copy Sheets("Held Appts 4 Submission").Cells(Sheets("Held Appts 4 Submission").Rows.Count, "A").End(xlUp).Offset(1, 0)
            If ws.AutoFilterMode = True Then ws.AutoFilterMode = False
        End If
    Next ws
    Application.ScreenUpdating = True
End Sub

You have 2 macros with the same name. Either re-name or delete the macro in Module1 or delete Module1 entirely.

 

[mumps]

Click here. This file is working for me.

What updates did you try?

 

[danj4fsu]

Click here. This file is working for me.

What updates did you try?

Just deleting the one module as suggested and re-entering the script. Strange it wasn't working on my end. I downloaded what you sent me and it works.


thank you