veri çekme

[metince54]

tekrarlı olan tablodan istediğim ürünün bilgileri getirme sorun surda o üründen birkaçtane olunca nasıl olcak. macro kullanmadım uygulama yapacağim excelin zaten boyutu büyük. eğer say ile bişeyler yapacaktım düzenin bozulmaması gerekiyor başka formül ve vba var. şimdiden teşekkürler

 

[Muzaffer Ali]

Bu işlem kod ile yapılırsa dosyanıza daha az yük olur.
Aşağıdaki kodları Sayfa2 nin kod sayfasına kopyalayın.
(Sayfa2 nin adını sağ tıklatın Kod Görüntüle seçin. Açılan sayfaya aşağıdaki kodları kopyalayın)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Range
    Dim SonSatir As Long
    Dim SonSatirAktar As Long
    With Worksheets("Data")
        SonSatir = .Cells(Rows.Count, "A").End(3).Row
        If Not Intersect(Target, Range("D2")) Is Nothing Then
            For Each Bak In .Range("A3:A" & SonSatir)
                If Bak.Value = Target.Value Then
                    SonSatirAktar = Cells(Rows.Count, "A").End(3).Row + 1
                    .Range("A" & Bak.Row & ":D" & Bak.Row).Copy Range("A" & SonSatirAktar)
                End If
            Next
        End If
    End With
End Sub

 

[metince54]

teşşükkür ederim yarın excelimde deneyeceğim sorun yok gibi. ilginiz için teşekkürler

 

[metince54]

Zahmet olmazsa verileri buna göre uyarlayabilir misiniz ben denedim beceremedim

Bu işlem kod ile yapılırsa dosyanıza daha az yük olur.
Aşağıdaki kodları Sayfa2 nin kod sayfasına kopyalayın.
(Sayfa2 nin adını sağ tıklatın Kod Görüntüle seçin. Açılan sayfaya aşağıdaki kodları kopyalayın)

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bak As Range
    Dim SonSatir As Long
    Dim SonSatirAktar As Long
    With Worksheets("Data")
        SonSatir = .Cells(Rows.Count, "A").End(3).Row
        If Not Intersect(Target, Range("D2")) Is Nothing Then
            For Each Bak In .Range("A3:A" & SonSatir)
                If Bak.Value = Target.Value Then
                    SonSatirAktar = Cells(Rows.Count, "A").End(3).Row + 1
                    .Range("A" & Bak.Row & ":D" & Bak.Row).Copy Range("A" & SonSatirAktar)
                End If
            Next
        End If
    End With
End Sub