Question

我在同一个工作簿中有两个工作表，它们有不同的包含策略信息的列数，我想使用vba根据某个列（状态）保存多个工作簿，因为尝试手动保存50次不是＆＃39最有效的方式。

sheet1中的状态是E列和E列。在sheet2中是第F列。现在是sheet1＆amp; sheet2有不同的范围＆amp;列可能需要单独定义最后一行。

我在网上找到了一些代码，但无法使其正常运行。我现在的问题是如何合并sheet2，然后使其工作。我现在的代码在行Windows(state).Activate

中有脚本超出范围错误

Sub ExtractToNewWorkbook()
    Dim ws     As Worksheet
    Dim wsNew  As Workbook
    Dim rData  As Range
    Dim rfl    As Range
    Dim state  As String
    Dim sfilename As String
    Dim LR1 As Long

    Set ws = ThisWorkbook.Sheets("Sheet1")
    LR1 = ws.Cells(Rows.Count, "A").End(xlUp).Row

    'Apply advance filter in your sheet
    With ws
        Set rData = Range("A1", "E" & LR1)
        .Columns(.Columns.Count).Clear
        .Range(.Cells(2, 5), .Cells(.Rows.Count, 5).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

        For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
            state = rfl.Text

            Set wsNew = Workbooks.Add
            sfilename = state & ".xlsx"

            'Set the Location
            ActiveWorkbook.SaveAs FilePath & sfilename
            Application.DisplayAlerts = False
            ws.Activate
            rData.AutoFilter Field:=5, Criteria1:=state
            rData.Copy

            Windows(state).Activate
            ActiveSheet.Paste
            ActiveWorkbook.Close SaveChanges:=True
        Next rfl

        Application.DisplayAlerts = True
    End With

    ws.Columns(Columns.Count).ClearContents
    rData.AutoFilter
End Sub

Answer 1

您应该避免ActiveWorkbook和.Activate（另请参阅：How to avoid using Select in Excel VBA）。而是直接访问工作簿wsNew：

Set wsNew = Workbooks.Add
sfilename = state & ".xlsx"

'Set the Location
wsNew.SaveAs FilePath & sfilename
Application.DisplayAlerts = False
rData.AutoFilter Field:=5, Criteria1:=state
rData.Copy

wsNew.Worksheets(1).Paste
wsNew.Close SaveChanges:=True

请注意，Set rData = Range("A1", "E" & LR1)您在范围之前错过了.，以使其使用with语句：Set rData = .Range("A1", "E" & LR1)
请注意，您应该考虑在整个过程中将wsNew重命名为wbNew，因为您设置了工作簿Set wsNew = Workbooks.Add而不是工作表。

脚本超出范围错误vba

1 个答案: