script out of range error vba

Question

I have two worksheets in the same workbook where they have different # of columns containing policy information and I would like to use vba to save multiple workbooks based on a certain column (state) since trying to save 50 times manually isn't the most efficient way.

State in sheet1 is column E & in sheet2 is column F. Now sheet1 & sheet2 have different ranges & columns so last row may need to be defined separately.

I found some codes online but wasn't able to make it work. My issues now is how to incorporate sheet2 and secondly make it work. The codes I have now have script out of range error in line 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

Try Windows(sfilename).Activate, Window object should have file extension if referred by name. The error you are receiving simply means that there is no window open with name specified. — Ryszard Jędraszyk
Thank you that solved half of my question. I will post a new question with revised codes on it. — sc1324

Pᴇʜ Pᴇʜ · Accepted Answer · 2018-04-27T09:12:43

You should avoid ActiveWorkbook and .Activate (also see: How to avoid using Select in Excel VBA). Instead access the workbook wsNew directly:

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

Note that in Set rData = Range("A1", "E" & LR1) you missed a . before the range to make it use the with statement: Set rData = .Range("A1", "E" & LR1)
Note that you should consider to rename wsNew into wbNew in your entire procedure because you set a workbook with Set wsNew = Workbooks.Add and not a worksheet.

script out of range error vba

1 Answers