基于A列单元格值的VBA工作表删除与另存功能开发求助

以下是整合了工作表清理和批量另存功能的完整代码：

Sub ProcessWorkbooks()
    Dim sourceWb As Workbook
    Dim orgWs As Worksheet
    Dim saveRange As Range
    Dim cell As Range
    Dim savePath As String, sourcePath As String
    Dim fileNamePrefix As String, fileNameSuffix As String
    Dim currentWs As Worksheet
    Dim keepSheetName As String
    Dim targetValue As String
    Dim i As Integer
    Dim foundCell As Range
    
    ' 配置参数
    Set orgWs = ThisWorkbook.Sheets("ORG")
    Set saveRange = orgWs.Range("A2:A" & orgWs.Range("A" & Rows.Count).End(xlUp).Row)
    sourcePath = "C:\Users\oey\Documents\Kris Oey\04 JAN FY24\Projects_WA_Summary_FY24 (TEST).xlsm"
    savePath = "C:\Users\oey\Documents\Kris Oey\FY24\"
    fileNamePrefix = "IWF - "
    fileNameSuffix = ".xlsm"
    keepSheetName = "IWF Extract"
    
    ' 遍历ORG表A列的每个目标值
    For Each cell In saveRange
        targetValue = cell.Value
        If targetValue <> "" Then
            ' 打开源工作簿
            Set sourceWb = Workbooks.Open(sourcePath)
            
            Application.ScreenUpdating = False
            Application.DisplayAlerts = False
            
            ' 倒序遍历工作表，避免删除时索引混乱
            For i = sourceWb.Sheets.Count To 1 Step -1
                Set currentWs = sourceWb.Sheets(i)
                ' 删除条件：不是保留工作表，且A列不含目标值
                If currentWs.Name <> keepSheetName Then
                    Set foundCell = currentWs.Columns("A").Find(What:=targetValue, LookIn:=xlValues, LookAt:=xlPart)
                    If foundCell Is Nothing Then currentWs.Delete
                End If
            Next i
            
            Application.DisplayAlerts = True
            
            ' 保存清理后的副本
            sourceWb.SaveCopyAs savePath & fileNamePrefix & targetValue & fileNameSuffix
            
            ' 关闭源工作簿，不修改原文件
            sourceWb.Close SaveChanges:=False
            Application.ScreenUpdating = True
        End If
    Next cell
End Sub

代码说明 #

• 工作表清理：
  • 倒序遍历源工作簿的所有工作表，防止正向删除导致的索引错位
  • 仅保留名为"IWF Extract"的工作表，以及A列包含当前目标值的工作表
  • 临时关闭提示框和屏幕更新，提升运行效率
• 批量另存：
  • 修正了原代码中路径拼接的多余斜杠问题
  • 跳过A列的空单元格，避免生成无效文件名
  • 保存副本后关闭源工作簿，不修改原始文件
• 注意点：
  • 确保ORG工作表在运行代码的工作簿内，否则需修改ThisWorkbook为对应工作簿引用
  • 确认源路径和保存路径存在，否则会触发文件不存在错误
  • 如果目标值包含文件名禁用字符（如\ / : * ? " < > |），需提前处理

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