CODEWITHSUNDEEP
vbaexcel
Alex Gale
Alex Gale

Reputation: 55

VBA Error '9' subscript Out of Range when copying worksheets

I'm Currently trying to create a code that will grab all the worksheets from a number of workbooks and paste them into a pre-selected workbook.

So far the code works, but only some of the time, the rest of the time it tells me that the workbooks("Name").Sheet(i) subscript out of range. There doesn't seem to be a pattern to the Error 

If Not UserForm1.filePath = "" Then
    Dim db As DAO.Database
    Set db = OpenDatabase(UserForm1.filePath)
    Dim rst As DAO.Recordset
    Set rst = db.OpenRecordset("tIO")
    Dim Filename As String
    Dim WS As Worksheet
    Dim Counter As Integer
    Dim i As Integer
    i = 1
        While Not rst.EOF
            If Not Filename = rst!Filename Then
                Filename = rst!Filename
                Dim wbSource As Workbook
                Set wbSource = Workbooks.Open(Filename:=Filename)

                Counter = Counter + 1
                'Loop through all of the worksheets in the Active workbook
                For Each WS In wbSource.Worksheets
                    WS.Activate
                    WS.Select
                    WS.Name = (WS.Name & "_" & Counter)
                    WS.Activate
                    WS.Select
                    WS.Copy After:=Workbooks("Appendix 3 V0_00.xls").Sheets(i)
                    i = i + 1
                Next
                wbSource.Close False
            End If
            rst.MoveNext
        Wend
End If

I wrote the Workbooks("Appendix 3 V0_00.xls") as it threw the same error up even more often when i used the with so now it looks like this;

If Not UserForm1.filePath = "" Then
    Dim db As DAO.Database
    Set db = OpenDatabase(UserForm1.filePath)
    Dim rst As DAO.Recordset
    Set rst = db.OpenRecordset("tIO")
    Dim Filename As String
    Dim WS As Worksheet
    Dim Counter As Integer
    Dim j As Integer
    While Not rst.EOF
        If Not Filename = rst!Filename Then
            Filename = rst!Filename
            Dim wbSource As Workbook
            If Dir(Filename) <> "" Then
                Set wbSource = Workbooks.Open(Filename:=Filename)
                Counter = Counter + 1
                'Loop through all of the worksheets in the Active workbook
                For j = 1 To wbSource.Worksheets.Count
                    wbSource.Sheets(j).Activate
                    wbSource.Sheets(j).Select
                    wbSource.Sheets(j).Name = (wbSource.Sheets(j).Name & "_" & Counter)
                    wbSource.Sheets(j).Activate
                    wbSource.Sheets(j).Select
                    wbSource.Sheets(j).Copy After:=Workbooks("Appendix 3 V0_00.xls").Sheets(Workbooks("Appendix 3 V0_00.xls").Sheets.Count)
                Next
                wbSource.Close False
            End If
        End If
        rst.MoveNext
    Wend


End If
wb.SaveAs (Module1.AppendicesFolder & "\" & UserForm1.TxtJobNumber & " " & UserForm1.TxtJobName & " Appendix3 V0.00.xls")
wb.Close

xlApp.Quit
End Sub

It seems to only happen after i have used it more than once could it be excel not closing down properly?

Upvotes: 2

Views: 4678

Answers (2)

Sepehr Moravej
Sepehr Moravej

Reputation: 56

Since there doesn't seem to be a pattern to the error you're getting, my guess is that the error stems from Sheets(i) not from Workbooks("Appendix 3 V0_00.xls") since you're not choosing a specific order of choosing worksheets from wbSource. To be quite honest, I can't really see what may be wrong in your code, but instead of

For Each WS in wbSource.Worksheets

try

For j = 1 To wbSource.Worksheets.Count

replacing every WS with Sheets(j). Technically speaking, this should not make much of a difference, but I have gotten rid of VBA errors many times by just making seemingly useless adjustments to my code. If you figure out the solution, please post it; I'm curious to see how you resolved the problem.

Upvotes: 0

R3uK
R3uK

Reputation: 14537

If the error is on WS.Copy After:=Workbooks("Appendix 3 V0_00.xls").Sheets(i), I suggest that you create a new Workbook variable.

Dim Wb As WorkBook
Set Wb = Workbooks("Appendix 3 V0_00.xls")

And then you use it into your copy line :

WS.Copy After:=Wb.Sheets(Wb.Sheets.Count)

Or as suggested by @Jeeped, you can simply use a With statement :

With Workbooks("Appendix 3 V0_00.xls")
    If Not UserForm1.filePath = "" Then
        Dim db As DAO.Database
        Set db = OpenDatabase(UserForm1.filePath)
        Dim rst As DAO.Recordset
        Set rst = db.OpenRecordset("tIO")
        Dim Filename As String
        Dim WS As Worksheet
        Dim Counter As Integer
        Dim i As Integer
        i = 1
            While Not rst.EOF
                If Not Filename = rst!Filename Then
                    Filename = rst!Filename
                    Dim wbSource As Workbook
                    Set wbSource = Workbooks.Open(Filename:=Filename)

                    Counter = Counter + 1
                    'Loop through all of the worksheets in the Active workbook
                    For Each WS In wbSource.Worksheets
                        WS.Activate
                        WS.Select
                        WS.Name = (WS.Name & "_" & Counter)
                        WS.Activate
                        WS.Select
                        WS.Copy After:= .Sheets(.Sheets.Count)
                        i = i + 1
                    Next
                    wbSource.Close False
                End If
                rst.MoveNext
            Wend
    End If
End With

Upvotes: 1

Related Questions