Yada başka yöntem galiba en ideal bu.

If Not Alan Is Nothing Then Alan.Copy .Range("F2")

Yukardaki kod aktarıyor. Tabi hücreler arasında boşluk olunca hata veriyor.
Örnek eklerseniz başka yöntemlede bakarız.

Sub DOLU_HUCRELERI_KOPYALA()

Dim Veri As Range, Alan As Range



For Each Veri In Sheets("Mahalle").Range("D2:E10001")

If Veri.Value <> "" Then

If Alan Is Nothing Then

Set Alan = Veri

Else

Set Alan = Application.Union(Alan, Veri)

End If

End If

Next



With Sheets("Veri")

    .Range("F2:G" & Rows.Count).ClearContents

    If Not Alan Is Nothing Then Alan.Copy .Range("F2")

    .Select

    .Range("F2").Select

End With

Application.CutCopyMode = False

End Sub