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
.Range("F2").Resize(Alan.Rows.Count, 2) = Alan.Value
.Select
.Range("F2").Select
End With
Application.CutCopyMode = False
End Sub
Eğer Mahalle sayfası D:E aralığını kopyalayacaksanız alttaki kodu deneyebilirsiniz.