Hsieh

1. Sub Ex()
   
2. Dim A As Range, B As Range, Ar(), CTR$, s&, Sh As Worksheet, Sht As Worksheet
   
3. For Each Sht In Sheets(Array("Sam", "Jeff", "Joe"))
   
4. With Sht
   
5. .Cells.Clear
   
6. Sheet2.Rows(1).Copy .[A1]
   
7. CTR = .Name
   
8. .Rows(1).Find(Title, lookat:=xlWhole).Offset(1, 0) = "*" & CTR & "*"
   
9. For Each Sh In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
   
10.     With Sh
    
11.     ReDim Preserve Ar(s)
    
12.     Ar(s) = .[A1:H1].Value
    
13.     s = s + 1
    
14.        Set A = .Columns("D")
    
15.        For Each B In A.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants)
    
16.            If InStr(B, CTR) > 0 Then ReDim Preserve Ar(s): Ar(s) = .Cells(B.Row, 1).Resize(, 8).Value: s = s + 1
    
17.        Next
    
18.     End With
    
19.     .[B65536].End(xlUp).Offset(2, -1).Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
    
20.     s = 0
    
21.     Erase Ar
    
22. Next
    
23. End With
    
24. Next
    
25. End Sub

½Æ»s¥N½X