ölçüte uyan satırları kopyalama

[quesh]

arkadaşlar;

ekteki dosyada "giriş" sayfasında bölge bazlı birçok veri bulunmakta olduğunu varsayalım. 3 adet bölge mevcut: A,B,C. "özet" sayfasında ise; B1 hücresinde bölge adını seçtiğimde (örneğin A) bu bölgeye ait tüm satırların ; "giriş" sayfasından "özet" sayfası C:F aralığına altalta kopyalanmasını istiyorum. aynı şekilde B1 hücresinden başka bir bölge adını (örneğin B) seçtiğimde "özet" sayfasındaki az önce A bölgesi için yapılan C:F aralığındaki verileri silip üstüne B bölgesiyle ilgili olanları yazmasını istiyorum. bu mümkün müdür VBA ile ?
saygılarımla.

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Dim alan As Integer
Dim s As Integer
Sayfa2.[c2:f1000] = ""
s = 2
alan = Sayfa1.Cells(65536, "a").End(xlUp).Row
Set bul = Sayfa1.Range("a2:a" & alan).Find(Sayfa2.[b1], , xlValues, xlWhole)
    If Not bul Is Nothing Then
        adres = bul.Address
        End If
        Do
        Sayfa2.Cells(s, "c") = Sayfa1.Cells(bul.Row, "a").Value
        Sayfa2.Cells(s, "d") = Sayfa1.Cells(bul.Row, "b").Value
        Sayfa2.Cells(s, "e") = Sayfa1.Cells(bul.Row, "c").Value
        Sayfa2.Cells(s, "f") = Sayfa1.Cells(bul.Row, "d").Value
        s = s + 1
        Set bul = Sayfa1.Range("a2:a" & alan).FindNext(bul)
        Loop While Not bul Is Nothing And bul.Address <> adres
End Sub