(02/04/2020, 23:24)yyhy yazdı: Ama örnek bir dosya var diye yazmışsınız

Rica ederim dosya var derken o dosanın kodlarını uyarladım.

Bu konu ile alakası ok aslında isterseniz onuda eklebilirim userformlu ve kendim için biraz gelişmiş olarak hazırlamıştım.

Tümü için boş gelmesi sebebi  veri = .Range("E4:P" & sonVeri).Value burdaki 4 ü 5 yaparsanızda sorun olmaz.ilk ekte 4.cü satır doludu hatırladığım.


Ayrıca eğer veri sayfası E sütunu arasında boşluklar olmazsa alttaki koduda kullanabilirsiniz.

With Sayfa1

            If .Range("E5").Value = "" Then

                Sayfa2.Range("D8:M" & Rows.Count).ClearContents

                GoTo son

            End If

            sonVeri = (.Range("E5", .Range("E5").End(xlDown)).Count - 1) + 5 '5 demek 5.ci satirdan basladigi icin

            veri = .Range("E5:P" & sonVeri).Value

        End With

Yukardaki kodu ekledim öncekinden ReDim arr(1 To 12, 1 To UBound(veri, 1)) satırına kadar yerleri.

Sub listele()

    

        Dim veri, sonVeri As Integer, key1, key2, say As Integer, i As Integer

        

        With Sayfa1

            If .Range("E5").Value = "" Then

                Sayfa2.Range("D8:M" & Rows.Count).ClearContents

                GoTo son

            End If

            sonVeri = (.Range("E5", .Range("E5").End(xlDown)).Count - 1) + 5 '5 demek 5.ci satirdan basladigi icin

            veri = .Range("E5:P" & sonVeri).Value

        End With

        

        ReDim arr(1 To 12, 1 To UBound(veri, 1)) '12 arama saydasi D ile P arasi sütun sayisi

        

        With Sayfa2

            If WorksheetFunction.CountA(.Range("D7:M7")) = 0 Then

                .Range("D8:M" & Rows.Count).ClearContents

                GoTo son

            End If

            

            key1 = "*" & .Range("D7").Value & "*|*" & .Range("E7").Value & "*|*" & .Range("F7").Value & "*|*" & .Range("G7").Value & "*|*" & _

                        .Range("H7").Value & "*|*" & .Range("I7").Value & "*|*" & .Range("J7").Value & "*|*" & _

                        .Range("K7").Value & "*|*" & .Range("L7").Value & "*|*" & .Range("M7").Value & "*"

        End With

        

        For i = LBound(veri) To UBound(veri)

            key2 = "*" & veri(i, 1) & "*|*" & veri(i, 2) & "*|*" & veri(i, 3) & "*|*" & veri(i, 5) & _

                                      "*|*" & veri(i, 6) & "*|*" & veri(i, 7) & "*|*" & veri(i, 8) & _

                                      "*|*" & veri(i, 9) & "*|*" & veri(i, 10) & "*|*" & veri(i, 11) & "*"

            If CStr(key2) Like CStr(key1) Then

                say = say + 1

                arr(1, say) = veri(i, 1)

                arr(2, say) = veri(i, 2)

                arr(3, say) = veri(i, 3)

                arr(4, say) = veri(i, 5)

                arr(5, say) = veri(i, 6)

                arr(6, say) = veri(i, 7)

                arr(7, say) = veri(i, 8)

                arr(8, say) = veri(i, 9)

                arr(9, say) = veri(i, 10)

                arr(10, say) = veri(i, 11)

            End If

        Next

        

        With Sayfa2 '******

            .Range("D8:M" & Rows.Count).ClearContents

            If say > 0 Then

                ReDim Preserve arr(1 To UBound(arr), 1 To say)

                .Range("D8").Resize(say, 10).Value = Application.Transpose(arr)

            End If

        End With '******

son:

        On Error Resume Next

        

        Application.ScreenUpdating = True

        

        Erase arr: key1 = vbNullString: key2 = vbNullString: Erase veri

End Sub