Subscript Out of Range error

[WxShady13]

I am copying data from multiple tables across several worksheets to one table on the Balance Tables worksheet. However when I do this I get a Subscript Out of Range error. The table it is writing to is BalanceTables table.

Sub Copy_Sheets_To_Master()
Call ClearBalanceTables
Dim wb As Workbook
Dim ws As Worksheet
Dim i, LastRowa, LastRowd As Long
Dim WSname As String
Dim ob As ListObjects


Set wb = ActiveWorkbook

For Each ws In wb.Sheets

If ws.Name <> "Balance Tables" Then
If ws.Name <> "Monthly Amount Due" Then
If ws.Name <> "Main" Then
If ws.Name <> "Key" Then
If ws.Name <> "Mail Merge-SNAIL" Then
If ws.Name <> "Mail Merge-EMAIL" Then
If ws.Name <> "VLOOKUP DATA" Then
If ws.Name <> "Payroll Table" Then
If ws.Name <> "Payment Log" Then
If ws.Name <> "Balance" Then
If ws.Name <> "VLOOKUP Rates" Then
If ws.Name <> "Master" Then


'This is the line causing the problems
Set ob = ws.ListObjects("BalanceTable")
WSname = ws.Name

'With ActiveSheet
ws.Cells(Rows.Count, 1).End(xlUp).EntireRow.Copy
iRow = iRow + 1
Sheets("Balance Tables").ListObjects("BalanceTable").DataBodyRange.Cells(iRow, 1).PasteSpecial Paste:=xlPasteValues

'End With
'LastRowa = ws.Cells(Rows.Count, "A").End(xlUp).Row
'LastRowd = Sheets("Balance Tables").Cells(Rows.Count, "A").End(xlUp).Row
'LastRowd = Sheets("Balance Tables").Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'Sheets("Balance Tables").ListObjects("BalanceTable").DataBodyRange.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
'ws.Range("A6" & LastRowa).EntireRow.Copy
'Sheets("Balance Tables").Range("A" & LastRowd + 1).PasteSpecial Paste:=xlPasteValues
'Sheets("Balance Tables").Range("A" + 1).PasteSpecial Paste:=xlPasteValues
'Sheets("Master").Range("A" & LastRowd + 1).Value = WSname
Worksheets("Balance Tables").Range("L6").Formula = "=VLOOKUP(A6,Table3[#All],7,FALSE)"
Worksheets("Balance Tables").Range("M6").Formula = "=VLOOKUP(A6,Table3[#All],8,FALSE)"
Worksheets("Balance Tables").Range("N6").Formula = "=VLOOKUP(A6,Table3[#All],9,FALSE)"
Worksheets("Balance Tables").Range("O6").Formula = "=VLOOKUP(A6,Table3[#All],10,FALSE)"
Worksheets("Balance Tables").Range("P6").Formula = "=VLOOKUP(A6,Table3[#All],11,FALSE)"
Worksheets("Balance Tables").Range("Q6").Formula = "=VLOOKUP(A6,Table3[#All],6,FALSE)"
Worksheets("Balance Tables").Range("R6").Formula = "=VLOOKUP(A6,Table3[#All],14,FALSE)"

End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

Next ws
ob.Resize ob.Range.Resize(iRow)
End Sub

 

[Fluff]

Are you getting the error on this line?

Set ob = ws.ListObjects("BalanceTable")

If so just delete it, as you're not actually using it.

 

[WxShady13]

Are you getting the error on this line?

Set ob = ws.ListObjects("BalanceTable")

If so just delete it, as you're not actually using it.

Yet again you are awesome! Thank you that worked

 

[Fluff]

You're welcome & thanks for the feedback.