Rica ederim.Son kod verileri getiriyordu.Bende sevmiyorum işin açığı son kodu ama kısa.Onu mesela *a* gibi aratırsanız a içerenleri bulur.Son kod zaten gelişmiş filte kodu.İlk yaptığım koddada sıkıntı yoktu.Birde fırsat bulunca başka yöntem uygularım.

Arşivimde bir dosya vardı zamanında yapmıltım aynısını.
| ile hücreleri birleştirip dizi içine alıp çok hızlıca veriler getiriliyordu.Sonra uygularım inşAalah onu.Verdiğim kodlar çalışıyor diye onu es geçmiştim

Youtubedede bolca örnekler var ilkini ekliyorum.Yinede bir izleyip anlamaya çalışın çok kolay.

İlk videoyu ilk defa izledim şimdi tam anlatamamış önce alanı dildirmeliydi.
Birde bunu izleyin yani mantığı anlarsanız kolay.

Option Compare Text



Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False

    With Sheets("Veri")

        If Not Intersect([D7:M7], Target) Is Nothing Then

          listele

        End If

    End With

Application.ScreenUpdating = True

End Sub

Sub listele()

    

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

        

        With Sayfa1

            sonVeri = .Cells(Rows.Count, "D").End(3).Row + 1

            veri = .Range("E4: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

Sayın farez butonlara hazırlamış olduğunuz macroyu atadım. Macro tam istediğim gibi olmuş yalnız; 1774/Ek-6 -S.K.M. tiki ne tıkladığım zaman verileri normal filitre ediyor. TÜMÜ tiki ne tıkladığımda veriyi bir satır boşluk vererek getiriyor. Dosyayı ekliyorum bir daha bakabilir misiniz?
Sayın farez yukarıda Mehmet hocamızdan vermiş olduğunuz videoyu izledim. Hobi amaçlı o küçük programın aynısını yaptım bunda sıkıntı yaşadım.Yukarıda bahsettiğim yeri de yapabilirsem sayenizde bunu da çözmüş olacağım. Teşekkürler.