请问: vba, excel中打开多个xls文件, 搜索字符串，写入另一个sheet的问题

目的: 打开一个"办公文具"的sheet,搜索其中"@yahoo"的字符串(包括@yahoo.com, @yahoo.cn等),将此单元格的内容复制到一个新的sheet里.直到整个"办公文具"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里?

--------------------

你好，我基本上写了一个程序可以实现你说的功能，不过和你目前的代码有点区别
请参照：
下面代码完成的功能，就是在sheet1中查找@yahoo,然后copy到sheet2中.测试过了可以使用
VBScript code

Sub FindStrings()
Dim firstCell, nextCell, stringToFind As String
Dim nCursor As Integer

stringToFind = "@yahoo"
nCursor = 1
nextCell = ""

Sheet1.Select
Range("A1").Select
Range("A1").Activate
Set firstCell = Cells.Find(What:=stringToFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False)
If firstCell Is Nothing Then
MsgBox "Search Value Not Found.", vbExclamation
Else
Sheet2.Cells(1, nCursor).Value = firstCell
nCursor = nCursor + 1

Do While firstCell.Address <> nextCell
If nextCell = "" Then
nextCell = firstCell.Address
End If
nextCell = Cells.FindNext(After:=Range(nextCell)).Address
If firstCell.Address <> nextCell Then
Sheet2.Cells(1, nCursor).Value = Range(nextCell).Value
nCursor = nCursor + 1
End If
Loop
End If
End Sub

-----------------------

>请问: 如何能够轮流打开全部的xls文件,将当中的sheet中符合"@yahoo"条件的单元格力的内容, 复制到"bak13" 这一>个sheet里?
这个应该不是难事，就是你把所有的xls放到一个目录里面
如下代码

VBScript code [code]
Dim path As String
path = "d:/work"
FileName = Dir(path & "/*.xls")
FileName = path & "/" & FileName

Do While FileName  <> "d:/work/"
......
FileName = Dir
FileName = path & "/" & FileName
Loop

-----------

未完：

http://topic.csdn.net/u/20080414/12/37f8af2d-9b74-495a-b14f-24b6e3f9496f.html

[/code]