Copying cells through data validation

Hi,

I'm running into trouble with some code I'm using. Essentially, the code uses data validation to allow a user to filter out information from a master worksheet that is then presented in a table on a separate sheet.

It filters through names in column A fine and then themes of survey Questions from column C. It then pastes the dates of the survey from column E onto the new sheet. But it isn't copying the score for the specific questions (which the user has checked) across from the date as expected.

The code for the module is below:

Sub RepTracker()

Dim lastrow As Long, lngCol As Long, chkSum As Long, i As Long
Dim LAname As String, ThemeSelect As String

Application.ScreenUpdating = False

With Sheet1

'// set the filter criteria to string variables based on drop down selections
LAname = .Range("B1").Value
ThemeSelect = Range("B2").Value
chkSum = WorksheetFunction.CountA(.Range("D3:AS3"))

'// clear the output cells to receive new data - -- adjust range if required
.Range("C6:U500").ClearContents


End With

'// confirm none of the selections are blank before applying filter and that at least one survey question is picked

Select Case True
Case LAname = "": MsgBox "Local Authority not selected", vbExclamation: Exit Sub
Case ThemeSelect = "": MsgBox "Theme not selected", vbExclamation: Exit Sub
Case chkSum < 1: MsgBox "At least one question must be selected", vbExclamation: Exit Sub
End Select


'// find last data row and column matching the hole selection then apply filter and copy results to sheet1

With Sheet4
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
.AutoFilterMode = False
.Range("A1:AU" & lastrow).AutoFilter Field:=1, Criteria1:=LAname
.Range("A1:AU" & lastrow).AutoFilter Field:=3, Criteria1:=ThemeSelect
.Range("E1:E" & lastrow - 1).Offset(1, 0).SpecialCells(12).Copy Sheet1.Range("C6")

On Error Resume Next
For i = 4 To 45
If Sheet1.Cells(3, i) = "a" Then
lngCol = Sheet1.Cells(2, i).Value + 4
End If
.Range(.Cells(1, lngCol), .Cells(lastrow - 1, lngCol)).Offset(1, 0).SpecialCells(12).Copy Sheet1.Cells(6, lngCol - 1)
Next i

End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub



And there is an additional private sub for Worksheet1:

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

If Not Intersect(Target, Range("D3:AS3")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If

End Sub


The main module code runs into an error on the line:

.Range("E1:E" & lastrow - 1).Offset(1, 0).SpecialCells(12).Copy Sheet1.Range("C6")

There is an error 1004: range of worksheet object is not defined.

Any idea what is going wrong?

Thanks,

Hugh