Soru Başka bir sayfada ki verileri yan yana getirme

[semih.gursoy]

Merhaba ,

Data sayfasında yer alan verileri mi?Özet sayfasına yan yana getirmek istiyorum.

Özet sayfasında sütunlarda yazan Satınalma gruplarının işemrine göre "TL Part not in Stock" sutununundaki karşılığı OK ise "OK" ,karşılığı yok ise boş ,Karşılığı NOK ise
Malzeme ve Tanımını getirtmek mümkün mü?
Yardım edecek arkadaşlara şimdiden Tşkler.
Örnek bir dosyayı ekte sunuyorum.

 

[semih.gursoy]

Günaydın İyi haftalar,
ekteki konuda yardımcı olabilecek arkadaşımız var mıdır.

 

[semih.gursoy]

Mrb Ustalar ,

Data tablosunda iki kaydı arıyoruz ama sonucu çokluyoruz bu biraz zor.
Data tablosunda malzemeden dolayı kaydı çokluyoruz sonuca NOK olanları istiyorum, burda birden fazla NOK varsa bunları hücreye yaz diyoruz formülle bu zor makro yazmak gerek bunun için yardımınıza ihtiyacım var.

 

[xman0608]

Sub ozetRapor()
    Set sD = Sheets("Data")
    Set sO = Sheets("Özet")

    Set sY = Sheets.Add(Sheets(1))

    Intersect(sD.Range("A:A,H:I,BQ:BQ,BW:BW"), sD.Range("A2:BX" & sD.Cells(Rows.Count, 1).End(3).Row)).Copy [a1]

    For i = 1 To Cells(Rows.Count, 1).End(3).Row
        If Cells(i, "D") = "OK" Then
            Cells(i, "B").Resize(, 2).ClearContents
        Else
            Cells(i, "D") = Cells(i, "B") & " " & Cells(i, "C")
            Cells(i, "B").Resize(, 2).ClearContents
        End If
    Next i

    [B:C].Delete
    Range("A:C").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
    Range("A:C").Sort [a1], , [c1], , , [b1], , xlNo
    son = Cells(Rows.Count, 1).End(3).Row

    ReDim lst(1 To son, 1 To 13)

    With CreateObject("Scripting.Dictionary")
        For i = 1 To son
            Sut = Replace(Cells(i, "C"), "E", "")
            If Sut = 99 Then
                Sut = 13
            Else
                Sut = Sut + 1
            End If
            ky = Trim(Cells(i, 1).Value)
            If Not .exists(ky) Then
                sat = sat + 1
                .Item(ky) = sat
                lst(sat, 1) = ky
            End If
            st = .Item(ky)
            If lst(st, Sut) = "" Or lst(st, Sut) = "OK" Then
                lst(st, Sut) = Cells(i, "B")
            Else
                If Cells(i, "B") <> "OK" Then lst(st, Sut) = lst(st, Sut) & "; " & Cells(i, "B")
            End If
        Next i
    End With

    sO.Select
    Rows("2:" & Rows.Count).ClearContents
    Cells(2, 1).Resize(sat, 13).Value = lst

    Application.DisplayAlerts = False
    sY.Delete
    Application.DisplayAlerts = True
End Sub

 

[semih.gursoy]

xman0608 Çok tşk ederim.Şahane olmuş.