Copy using two sheets

[Khalil Handal]

Hi,
I have 2 workbooks, the first is: HCP_2005 with one of the sheets named
"October 2005"and the second is WV_2005 with one of it's sheets "Oct".
The following macro filters a range and copy the filtered rows to the second
workbook to the mentioned sheet in the second workbook named "Oct".

I need ALSO to copy the cells D1 & D2 from the sheet "October 2005" in
"HCP_2005" to the same location in the second workbook "WV_2005" in the
sheet "Oct". I am not succeding to do it. It seems I am missing something.

Can any one help?

the code:

Sub Macro1()

Dim RngToFilter As Range
Dim RngToCopy As Range
Dim DestWks As Worksheet
Dim DestCell As Range
Dim LastRow As Long

With ActiveSheet
.Unprotect Password:="1230"
'turn off any existing filter
.AutoFilterMode = False
Set RngToFilter = .Range("ei7", .Cells(.Rows.Count, "EI").End(xlUp))
RngToFilter.AutoFilter Field:=1, Criteria1:="<>"
If RngToFilter.Cells.SpecialCells(xlCellTypeVisible).Count = 1 Then
'no visible rows in filter.
Set RngToCopy = Nothing
Else
With RngToFilter
Set RngToCopy = .Resize(.Rows.Count - 1, 1).Offset(1, 0) _
.Cells.SpecialCells(xlCellTypeVisible)
End With
End If
.AutoFilterMode = False
.Protect Password:="1230"
End With

If RngToCopy Is Nothing Then
MsgBox "Nothing filtered--quitting"
Exit Sub
End If

Set DestWks = Nothing
On Error Resume Next
Set DestWks = Workbooks("wv_2005.xls").Worksheets("Oct")
On Error GoTo 0
If DestWks Is Nothing Then
Set DestWks = Workbooks.Open(ThisWorkbook.Path &
"\WV_2005.xls").Worksheets("Oct")
End If

With DestWks
' delete any previous lines after row 7
Worksheets("Oct").Select
Rows("7:50").Select
Selection.ClearContents
Range("A7").Select
' previous line added by me

LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
Set DestCell = .Cells(LastRow, "A")
End With

RngToCopy.EntireRow.Copy _
Destination:=DestCell

Application.CutCopyMode = False

End Sub


Khalil