I have a code from Ron de Bruin's website that I used to copy rows from a
data sheet to multiple other sheets based on the contents of a cell in column
AG.

The code worked great in setting up the sheets. The problem I get is when I
add a row to the data sheet and run the code I get an error message,
"Subscript out of range".

The data sheet has 33 colums ending in AG. I do not have any merged cells,
there are no empty rows and the headers are unique.

I need to be able to add a row to the data sheet and have it copied to the
corresponding sheet.

Here is a copy of the code I am using:
Sub Copy_To_Worksheets_2()
' This sub uses the functions LastRow and SheetExists
Dim CalcMode As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim WSNew As Worksheet
Dim rng As Range
Dim cell As Range
Dim Lrow As Long
Dim DestRange As Range
Dim FieldNum As Integer
Dim Lr As Long

'Name of the sheet with your data
Set ws1 = Sheets("All") '<<< Change

'Set filter range : A1 is the top left cell of your filter range and
'the header of the first column, D is the last column in the filter range
Set rng = ws1.Range("A1:ag" & Rows.Count)

'Set Field number of the filter column
'This example filters on the first field in the range(change the field
if needed)
'In this case the range starts in A so Field:=1 is column A, 2 = column
B, ......
FieldNum = 33

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

' Add a worksheet to copy the a unique list and add the CriteriaRange
Set ws2 = Worksheets.Add

With ws2
'first we copy the Unique data from the filter field to ws2
rng.Columns(FieldNum).AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("A1"), Unique:=True

'loop through the unique list in ws2 and filter/copy to a worksheet
Lrow = .Cells(Rows.Count, "A").End(xlUp).Row
For Each cell In .Range("A2:A" & Lrow)

If SheetExists(cell.Value) = False Then
Set WSNew = Sheets.Add
On Error Resume Next
WSNew.Name = cell.Value
If Err.Number 0 Then
MsgBox "Change the name of : " & WSNew.Name & " manually"
Err.Clear
End If
On Error GoTo 0
Set DestRange = WSNew.Range("A1")
Else
Set WSNew = Sheets(cell.Text)
Lr = LastRow(WSNew)
Set DestRange = WSNew.Range("A" & Lr + 1)
End If

'Firstly, remove the AutoFilter
ws1.AutoFilterMode = False

'Filter the range
rng.AutoFilter Field:=FieldNum, Criteria1:="=" & cell.Value

'Copy the visible data and use PasteSpecial to paste to the
worksheet
ws1.AutoFilter.Range.Copy
With DestRange
.Parent.Select
' Paste:=8 will copy the columnwidth in Excel 2000 and higher
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
.Select
End With
' Delete the header row if you copy to a existing worksheet
If Lr 0 Then WSNew.Range("A" & Lr + 1).EntireRow.Delete

'Close AutoFilter
ws1.AutoFilterMode = False

Lr = 0
Next cell

'Delete the ws2 sheet
On Error Resume Next
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
On Error GoTo 0

End With

With Application
.ScreenUpdating = True
.Calculation = CalcMode
End With
End Sub