搜索字符串写入另一个sheet的问题

Sub 宏1() 
' 
' 宏1 Macro 
' 

' 
    Sheets("办公文具").Select 
    Sheets.Add.Name = "bak13" 
     
    Sheets("办公文具").Select 
    Range("B1").Select 
    Cells.Find(What:="@yahoo", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCASE:= _ 
        False).Activate 
    'Range("B13").Select 
    'Selection.Copy 
    'Sheets("bak2").Select 
    'ActiveSheet.Paste 
    'Range.Next 
    'Sheets("办公文具").Select 
    'Application.CutCopyMode = False 
    'Cells.FindNext(After:=ActiveCell).Activate 

'While Cells.Text  <> Null 

    Selection.Copy 
    Sheets("bak13").Select 
     
    'ActiveSheet.ActiveCell. 
     

    ActiveSheet.Paste 
    ActiveCell.Next      <----问题出在这里 
    Sheets("办公文具").Select 
    Application.CutCopyMode = False 
    Cells.FindNext(After:=ActiveCell).Activate 
'Cells.Find. 
'Wend 


  

End Sub 

另外还有一个问题: 

如果某个目录下有多个xls文件(包括"办公文具.xls"文件),每个文件里都有一个sheet,情况类似"办公文具sheet". 
请问: 如何能够轮流打开全部的xls文件,将当中的sheet中符合"@yahoo"条件的单元格力的内容, 复制到"bak13" 这一个sheet里?





Sub FindStrings()  
Dim path As String  
path = "I:\wentrip\promotion\data\2007data"  
Filename = Dir(path & "\*.xls")  
Filename = path & "\" & Filename