How to copy a cell range based on a condition

**GregoryA** · 08-16-2012, 12:02 AM

Hi all.
I have posted this somewhere else but i had no luck, (most likely my own fault).
What i need to do to search through several worksheets and look for the word 'Case Closed' in column G on rows 2 - 88 and when this is found then i need to copy the contents of cells A to E of the same row to a summary page.

Please help this is driving me nuts.

**rylo** · 08-16-2012, 12:10 AM

Hi

Makes some assumptions (:-)) but should get you started.

Sub aaa()
  Dim OutSH As Worksheet
  Set OutSH = Sheets("Summary")
  
  For Each sh In Sheets
    If sh.Name <> "Summary" Then
      Set findit = sh.Range("G:G").Find(what:="Case Closed")
      If Not findit Is Nothing Then
        With sh
          firstadd = findit.Address
          Do
            .Cells(findit.Row, 1).Resize(1, 5).Copy Destination:=OutSH.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            Set findit = .Range("G:G").Find(what:="Case Closed", after:=findit)
          Loop Until findit.Address = firstadd
        End With
      End If
    End If
  Next sh
End Sub

rylo

**JOHN H. DAVIS** · 08-16-2012, 10:43 AM

Another option:

Sub GregoryA()

Dim ws As Worksheet

For Each ws In Worksheets

    If ws.Name <> "Summary" Then

        Range("G1:G88").AutoFilter Field:=1, Criteria1:="Case Closed"
        Range("A1:E88").SpecialCells(xlCellTypeVisible).Copy Sheets("Summary").Range("A" & Rows.Count).End(3)(2)

    End If

ActiveSheet.AutoFilterMode = False

Next ws

End Sub

**GregoryA** · 08-16-2012, 09:58 PM

Hi Guys,
Thank you both i will try both ways out shortly.

**GregoryA** · 08-17-2012, 01:42 AM

Hi.
I thank you both for your answers and both way's do work,(and work well).

However with cell protection and work sheet sharing that is turned on in differant work books neither way works for all.

(i did fear this)

So i have try another approach which is seems to have to be to have a separate work book open and have the macro run from there, and have the data copied from closed work books into the separate open work book.

Any and all ideas and suggestion will be greatly appreiciated.