Problem with copying from a range

[ninjalearner]

Dear All, I wrote this code to copy contents of a range selection and paste it on another worksheet. The thing is that i want contents of only those rows withing the range that have values in their column C copied but my code copies everything. I am trying to resolve the problem of copying all.


Set DestinationSheet = Sheets("Sheet2").Range("A5:C12")

For Each Cell In ActiveWorkbook.Worksheets("Sheet1").Range("C4:C45")

If Cell.Value >= 1 Then

Set CopyRng = Sheets("Sheet1").Range("A4:C45")

CopyRng.Copy

With DestinationSheet.Cells

.PasteSpecial xlPasteValues

.PasteSpecial xlPasteFormats

Application.CutCopyMode = False


Any Ideas Will Be Appreciated

 

[Luke M]

You can use the Union method to add the relevant rows.

[pre]

Sub CopyOnlySome()
Dim DesintationSheet As Range
Dim c As Range
Dim CopyRng As Range

Set DestinationSheet = Sheets("Sheet2").Range("A5:C12")
With ActiveWorkbook.Worksheets("Sheet1")
For Each c In .Range("C4:C45")
If c.Value >= 1 Then
If CopyRng Is Nothing Then
Set CopyRng = .Range(.Cells(c.Row, "A"), .Cells(c.Row, "C"))
Else
Set CopyRng = Union(CopyRng, .Range(.Cells(c.Row, "A"), .Cells(c.Row, "C")))
End If
End If
Next c
End With
CopyRng.Copy
With DestinationSheet.Cells
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Application.CutCopyMode = False
End Sub

[/pre]