Bir hücrenin degerini göre satırları kopyala ve yapıstır

[fikretac]

Merhaba Arkadaşlar. Sayfa1 de 200 satir ve 20 sütun olan cizelgemde her sütunun baslığı var. F2 hücresine sütun basliklarindan oluşan veri dogrulama listesi ekledim. F2 hucresinde sectigim ismin sütununda sayı olan satırlari ( sadece a b,c,d ve kendi sütununu ) sayfa2 ye kopyalayacak bir makro yapabilirmiyiz. Hücre bicimleride kopyalanacak. Hücrelerde formül yok. Tsk ederim.

 

[Necdet]

Merhaba,
sorunuzu tam anladım derken, parantez içindeki açıklama her şeyi değiştirdi. Kısaca olayı anlamadım.
Örnek dosyanızı dosya.co, dosya.tc gibi paylaşım sitelerinden birine yükleyip, olması gerekeni de belirtirseniz, çözüme ulaşmanız hızlanacaktır.

 

[fikretac]

Necdet bey dosyayi ekleyemiyorum kusura bakmayin. a,b,c,d 5-205 hucrelerinde malzeme listesi ve bilgileri var. F4-Z4 hucrelerinde isim listesi ( sutun basligi ) var. f2 hucresindeki veri listesinden sütun baslıgı olan ismi sectiginde... o sütunda sayı olan satırlardaki, a,b,c,d ve kendi sutunundaki verileri alt alta sayfa2 ye kopyalayacak... anlatabildim mi bilmiyorum.

 

[Necdet]

Necdet bey dosyayi ekleyemiyorum kusura bakmayin.

Rica ederim, neden kusura bakayım ki?

 

[veyselemre]

Sayfa2 nin kod sayfasına ekleyin.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$F$2" Then
        Dim bul, s1, lR, r, cl
        Set s1 = Sheets("Sayfa1")
        Set bul = s1.Range("E4:Z4").Find(Target.Value)
        If Not bul Is Nothing Then
            lR = s1.Cells(Rows.Count, 1).End(3).Row
            If lR > 1 Then
                Range("A:E").Clear
                cl = bul.Column
                Set r = s1.Range(s1.Cells(4, "AA"), s1.Cells(lR, "AA"))
                r.FormulaR1C1 = "=ISNUMBER(RC[-" & 27 - cl & "])"
                s1.Range("AA4").Value = "ISNUMBER"
                r.AutoFilter Field:=1, Criteria1:="TRUE"
                If r.SpecialCells(xlCellTypeVisible).Count > 1 Then
                    s1.Range("A4:D" & lR).Copy Range("A4")
                    s1.Range(s1.Cells(4, cl), s1.Cells(lR, cl)).Copy Range("E4")
                End If
                r.AutoFilter
                r.ClearContents
                Range("A:E").EntireColumn.AutoFit
            End If
        End If
    End If
End Sub

 

[fikretac]

Veysel bey dosyanizdaki makroda sorun var sanırım. Kendi belgemede ekledim ama farklı calıstı. Dosyamı ekledim. Genel sayfasi I3 de ismi degistirdigimde o sutunda sayı olan satirlardaki hücreler senet sayfasina aktarılmasini istiyorum. yardımcı olabilirmisiniz. Tsk ederim. ( not. dosyamdaki sutunlar degisti )

 

[fikretac]

Konu aktiftir... yardımcı olabilirseniz sevinirim...