如何将3个功能关联的VBA子过程合并为一个可通过按钮正常执行的子程序

• 第三个子过程无效果：原代码依赖ActiveSheet对象，第一个子过程运行结束后激活的是工作表1，单独触发第三个子过程时默认操作的是工作表1，而非需要处理的工作表3，因此不会产生预期效果。
• 按钮上移：Excel表单控件默认属性为「大小和位置随单元格而变」，删除行操作会带动上方按钮的位置同步变化，右键按钮进入属性设置，选择「大小固定，位置不随单元格改变」即可解决该问题。

Sub 一键合并处理()
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    Dim FolderPath As String
    Dim Filename As String
    Dim Sheet As Worksheet
    Dim fCell As Range
    Dim strFind As String
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim N As Long, L As Long, r As Range
    Dim s As String, v As String
    
    ' ========== 第一个功能：合并指定路径下所有工作簿的工作表 ==========
    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
    
    ' ========== 第二个功能：提取filename列内容到工作表3 ==========
    strFind = "filename"
    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 "未找到filename关键词，程序终止"
        GoTo 结束处理
    End If
    Intersect(wsSource.UsedRange.Offset(1), fCell.EntireColumn).Copy wsDest.Range("a2")
    
    ' ========== 第三个功能：保留E列含apple的行 ==========
    Set r = wsDest.Range("e2", wsDest.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
    
    ' 结束后激活目标工作表
    wsDest.Activate
    
结束处理:
    Application.ScreenUpdating = True
End Sub

• 将上述代码复制到你的VBA模块中，给按钮绑定一键合并处理这个过程即可实现单次点击完成所有操作
• 解决按钮移位问题操作路径：右键点击按钮 → 选择「设置控件格式」→ 「属性」标签 → 勾选「大小固定，位置不随单元格改变」即可。

内容的提问来源于stack exchange，提问作者MAtyAS