Expert: Damon Ostrander - 9/2/2009

Question
Hi Damon,

I have been searching for the right code to do the job and thank you so much for writing this up short and sweet. The only problem is that I have several source of worksheets in different names, e.g. Region A, Region B etc.. worksheets which i need to extract all the "Yes" related info and transferred to another sheet. The result would show a list of all the combined region "Yes" subscriber customer info.  The previous code you have written, I have modified alittle:

Sub CopyYes()

 'Copy cells of cols A,B,C,D,E,F,G from rows containing "Yes" in
 'col H of the active worksheet (source sheet) to cols
 'A,B,C,D,E,F,G of Sheet2 (destination sheet)
 Dim DestSheet        As Worksheet
 Set DestSheet = Worksheets("Sheet2")
 
 Dim sRow       As Long     'row index on source worksheet
 Dim dRow       As Long     'row index on destination worksheet
 Dim sCount     As Long
 sCount = 0
 dRow = 1

 For sRow = 1 To Range("D65536").End(xlUp).Row
    'use pattern matching to find "Yes" anywhere in cell
    If Cells(sRow, "H") Like "*Yes*" Then
       sCount = sCount + 1
       dRow = dRow + 1
       'copy cols A,B,C,D,E,F,G& H
       Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
       Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, "B")
       Cells(sRow, "C").Copy Destination:=DestSheet.Cells(dRow, "C")
       Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
       Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "E")
       Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "F")
       Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "G")
       Cells(sRow, "H").Copy Destination:=DestSheet.Cells(dRow, "H")
    End If
 Next sRow
 
 MsgBox sCount & " Subscriber rows copied", vbInformation, "Transfer Done"

End Sub

Would be much grateful if you would help out alittle here.

Thank you very much  

Answer
Hi VaC,

I assume you mean that you want to loop through all the region sheets, performing the same operation with each sheet, appending the data to the destination sheet.  I have added such a loop to the code below.  Note that I used a For Each loop and an Array() function to define the collection of items.  You can put the list of region sheet names in this Array list, each name in quotes and separated by commas as I have done.  I believe this does what you want.

Sub CopyYes()

'Copy cells of cols A,B,C,D,E,F,G from rows containing "Yes" in
'col H of the region worksheet (source sheet) to cols
'A,B,C,D,E,F,G of Sheet2 (destination sheet)
Dim DestSheet  As Worksheet
Set DestSheet = Worksheets("Sheet2")
Dim Region     As Variant

Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long
sCount = 0
dRow = 1

For Each Region In Array("Region A", "Region B", "Region C")

  With Worksheets(Region)
  
     For sRow = 1 To .Range("D65536").End(xlUp).Row
        'use pattern matching to find "Yes" anywhere in cell
        If .Cells(sRow, "H") Like "*Yes*" Then
           sCount = sCount + 1
           dRow = dRow + 1
           'copy cols A,B,C,D,E,F,G& H
           .Cells(sRow, "A").Copy Destination:=DestSheet.Cells(dRow, "A")
           .Cells(sRow, "B").Copy Destination:=DestSheet.Cells(dRow, "B")
           .Cells(sRow, "C").Copy Destination:=DestSheet.Cells(dRow, "C")
           .Cells(sRow, "D").Copy Destination:=DestSheet.Cells(dRow, "D")
           .Cells(sRow, "E").Copy Destination:=DestSheet.Cells(dRow, "E")
           .Cells(sRow, "F").Copy Destination:=DestSheet.Cells(dRow, "F")
           .Cells(sRow, "G").Copy Destination:=DestSheet.Cells(dRow, "G")
           .Cells(sRow, "H").Copy Destination:=DestSheet.Cells(dRow, "H")
           'DestSheet.Cells(dRow, "I") = Region   'Uncomment this line to add region in column I
        End If
     Next sRow
  
  End With
  
Next Region

MsgBox sCount & " Subscriber rows copied", vbInformation, "Transfer Done"

End Sub

Note my use of the With statement and the "." in front of the source worksheet range references because the source sheet is no longer assumed to be the active worksheet.  

Note also that I added a commented-out line to add the Region name to column I in the destination sheet.  Simply remove the first apostrophe to un-comment it if you want to do this.

Keep Excelling.

Damon