Object Required

[Al]

My code copies a range from each sheet in a folder to a new wkbk. The sheets
appear to be all the same, however I am getting a Run TIme Error of 424
Object required. I cannot find a difference between the sheets Nay ideas?

This is my code....

Sub ProcessFiles()
Dim oFSO As Object
Dim i As Long
Dim sFolder As String
Dim fldr As Object
Dim oFolder As Object
Dim oFile As Object
Dim oFiles As Object
Dim this As Workbook
Dim iRow As Long
Dim oSh As Worksheet
Dim rng As Range
Dim v As Variant
Dim j As Long, k As Long
Dim sDate1 As String
Dim sDate2 As String
Dim temp As String
Set oFSO = CreateObject("Scripting.FileSystemObject")

Set this = ActiveWorkbook
Set oSh = ActiveSheet
sFolder = ThisWorkbook.Path
If sFolder = "" Then Exit Sub
Set oFolder = oFSO.GetFolder(sFolder)
Set oFiles = oFolder.Files
ReDim v(1 To oFolder.Files.Count)
i = 0
For Each oFile In oFiles
If oFile.Type = "Microsoft Excel Worksheet" _
And LCase(oFile.Path) <> LCase(ThisWorkbook.FullName) Then
i = i + 1
v(i) = oFile.Path
End If
Next
ReDim Preserve v(1 To i)
For j = 1 To UBound(v) - 1
For k = j + 1 To UBound(v)
sDate1 = Mid(v(j), Len(v(j)) - 9, 6)
sDate2 = Mid(v(k), Len(v(k)) - 9, 6)
If sDate2 < sDate1 Then
temp = v(k)
v(k) = v(j)
v(j) = temp
End If
Next
Next
For i = 1 To UBound(v)
Workbooks.Open Filename:=v(i)
With ActiveWorkbook
On Error Resume Next
Set rng = _
.Worksheets("transmission").Range("A337:A383") _
.SpecialCells(xlFormulas)
On Error GoTo 0
If Not rng Is Nothing Then
iRow = oSh.Cells(Rows.Count, 2).End(xlUp).Row
If iRow <> 1 Then iRow = iRow + 1
rng.Copy Destination:=oSh.Cells(iRow, 2)
End If
.Close SaveChanges:=False
End With
Next i
End Sub


Thanks for the help!