excel - 满足下一个空白单元格条件时中止宏

Question

我试图在满足空白单元格条件但随后接收到时中止循环函数

"Run time error 1004: method 'save as object' workbook failed".

它工作正常，但不知何故宏在

wbMaster.SaveAs ("C:\Users\folder\Desktop\" & ActiveCell.Value & ".xls")

线。我用 If (IsEmpty(ActiveCell)) Then Exit Sub认为它会在满足条件后中止宏但仍然没有运气。
在下面让我知道你们对我的脚本的看法。任何建议将不胜感激。

Sub Manipulate()
    Dim wbMaster As Workbook
    Dim wbLocal As Workbook
    
    Set wbLocal = ThisWorkbook
    
    If (IsEmpty(ActiveCell)) Then Exit Sub
    
    Do Until ActiveCell.Value = ""
        Set wbMaster = Workbooks.Open("C:\Users\folder\Desktop\Output.xlsx")
        wbLocal.Worksheets("Input").Activate
         
        wbMaster.Worksheets("Output").Range("B3").Value = ActiveCell.Value
        wbMaster.SaveAs ("C:\Users\folder\Desktop\" & ActiveCell.Value & ".xls")
        wbMaster.Close True
        
        ActiveCell.Offset(1, 0).Select
    Loop
    MsgBox "Export Finished"
End Sub

Answer 1

一些事情

避免使用 ActiveCell .您可能想查看 How to avoid using Select in Excel VBA

定义和使用 对象

查找 最后一行 在相关栏目中。这将很容易循环。您可能想查看 How to find last row

使用错误处理 当您尝试使用动态字符串保存工作簿时，它可能会失败。

保存文件时，不仅要指定具有正确扩展名的文件名，还要指定相关的file format。 .您可能想阅读 Workbook.SaveAs method (Excel)

尝试这个。我已经评论了下面的代码。

Option Explicit

Sub Manipulate()
    Dim wbMaster As Workbook
    Dim wbLocal As Workbook
    Dim wsLocal As Worksheet
    
    On Error GoTo Whoa
    
    Set wbLocal = ThisWorkbook
    '~~> Change this to the relevant sheet
    Set wsLocal = wbLocal.Sheets("Sheet1")
    
    Dim StartRow As Long
    Dim StartCol As String
    Dim EndRow As Long
    Dim i As Long
    
    '~~> This specifies to start from row 1 of col A which is A1
    '~~> Change as applicable
    StartRow = 1
    StartCol = "A"
    
    With wsLocal
        '~~> Get the last row in that column
        EndRow = .Range(StartCol & .Rows.Count).End(xlUp).Row
        
        '~~> Loop from the start row to end row
        For i = StartRow To EndRow
            '~~> Check if the cell in between is empty or not
            If Len(Trim(.Range(StartCol & i).Value2)) <> 0 Then
                '~~> Open workbook
                Set wbMaster = Workbooks.Open("C:\Users\folder\Desktop\Output.xlsx")
                '~~> Set value
                wbMaster.Worksheets("Output").Range("B3").Value = .Range(StartCol & i).Value2
                
                '~~> Save the file
                wbMaster.SaveAs (Filename:= "C:\Users\folder\Desktop\" & _
                                 .Range(StartCol & i).Value2 & _
                                 ".xls", FileFormat:= 56)
                
                '~~> Give time to excel to save the file.
                DoEvents
                
                '~~> Close without saving. We already saved above
                wbMaster.Close False
            End If
        Next i
    End With
    
    MsgBox "Export Finished"
    
    Exit Sub        
Whoa:
    MsgBox Err.Description
End Sub