vba - 如何将 3 个 VBA 子程序合二为一？

Question

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

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

最后，最后一个子应在工作表 3 的 e2:e100 中搜索单词“apple”，并删除未找到“apple”的每一行。

我创建了 3 个按钮并将潜艇分配给每个按钮。前两个运行良好，做我想做的事，但是当我点击第三个按钮（后面有第三个子）时，什么也没有发生，

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

如何将所有 3 个潜艇合并为一个（实际上是通过单击按钮）？提前致谢！！！

Sub ConslidateWorkbooks()

Dim FolderPath As String

Dim Filename As String

Dim Sheet As Worksheet

Application.ScreenUpdating = False

FolderPath = "D:\Users\Cons\excel\"

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

标签： vbaconditional-statementsrow

Answer 1

Sub TheOneSub()
    ConslidateWorkbooks
    FindInFirstRow
    SaveSomeRows
End Sub 

Sub ConslidateWorkbooks()
    ...
End Sub 

Sub FindInFirstRow()
    ...
End Sub 

Sub SaveSomeRows()
    ...
End Sub