如何将3个VBA子例程合并为一个

第一个子集合位于D:\Users\Cons\excel中的工作簿的所有工作表。

然后第二个子查找单词"；文件名"；在工作表2中，然后将下面的所有单元格复制到工作表3中的A2。

最后，最后一个子应该搜索单词"；苹果；在工作表3的e2:e100中，并删除其中"的每一行；苹果；找不到。

我创建了3个按钮，并为每个按钮分配了子按钮。前两个运行良好，做我想做的事，但当我点击第三个按钮(后面有第三个子(时，什么都没发生，

只有上面的前两个按钮向上移动，不知道为什么。

我如何将所有的3个子组合成一个(实际上只需点击一个按钮就可以了(？提前感谢！！！

Sub ConslidateWorkbooks()
Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "D:UsersConsexcel"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
Worksheets(1).Activate
End Sub

Sub FindInFirstRow()
Dim fCell As Range
Dim strFind As String
Dim wsSource As Worksheet
Dim wsDest As Worksheet
'What shall we look for?
strFind = "filename"
'What sheet are we getting data from/to?
Set wsSource = Worksheets(2)
Set wsDest = Worksheets(3)
Set fCell = wsSource.Range("1:1").Find(what:=strFind, lookat:=xlPart, MatchCase:=False)
If fCell Is Nothing Then
MsgBox "No match found"
Else
'Copy the cells *below* to A2 of destination sheet
Intersect(wsSource.UsedRange.Offset(1), fCell.EntireColumn).Copy wsDest.Range("a2")
End If
End Sub

Sub SaveSomeRows()
Dim N As Long, L As Long, r As Range
Dim s As String, v As String
Set r = ActiveSheet.Range("e2", ActiveSheet.Range("e100").End(xlUp))
N = r.Count
s = "apple"
For L = N To 1 Step -1
v = LCase(r(L).Value)
If InStr(1, v, s) = 0 Then
r(L).EntireRow.Delete
End If
Next L
End Sub