Filtre Senkronizasyonu Hk.

[petsiye]

Merhaba,

"Yatırım" isimli ve "Kopya" isimli iki ayrı sheet'im var. Bu 2 Sheet içerik ve vs bakımından birbiri ile tamamen aynı. Acaba, "Yatırım" isimli Sheet üzerinde herhangi bir sütunda bir filtre yaptığımda, Aynı filtre "Kopya" isimli diğer Sheet'tede çalıştırılabilir mi ?

Saygılarımla

 

[petsiye]

Bu konu hakkında yardımcı olur musunuz

 

[petsiye]

Asıl amacınız nedir ki böyle birşeye ihtiyaç duyuyorsunuz. Bu bir makro ile yapılabilir:
Deneyiniz:

Option Explicit

Sub SyncFilters()
    Dim wsInvestment As Worksheet
    Dim wsCopy As Worksheet
    Dim filterRange As Range
    Dim field As Integer
    Dim criteria1 As Variant
    Dim operator As XlAutoFilterOperator
    Dim criteria2 As Variant
    Dim visibledropdown As Boolean
    Dim i As Integer

    Application.ScreenUpdating = False

    On Error GoTo ErrHandler

    Set wsInvestment = ThisWorkbook.Sheets("Yatırım")
    Set wsCopy = ThisWorkbook.Sheets("Kopya")

    If wsInvestment.AutoFilterMode Then
        Set filterRange = wsInvestment.AutoFilter.Range
        wsCopy.AutoFilterMode = False
        filterRange.Copy Destination:=wsCopy.Range(filterRange.Address)

        For i = 1 To filterRange.Columns.Count
            If filterRange.Columns(i).AutoFilter.FilterOn Then
                field = i
                criteria1 = filterRange.AutoFilter.Filters(field).Criteria1
                operator = filterRange.AutoFilter.Filters(field).Operator
                visibledropdown = filterRange.AutoFilter.Filters(field).On
                If operator = xlFilterValues Then
                    criteria2 = filterRange.AutoFilter.Filters(field).Criteria2
                    wsCopy.Range(filterRange.Address).AutoFilter field:=field, Criteria1:=criteria1, Operator:=operator, Criteria2:=criteria2, VisibleDropDown:=visibledropdown
                Else
                    wsCopy.Range(filterRange.Address).AutoFilter field:=field, Criteria1:=criteria1, Operator:=operator, VisibleDropDown:=visibledropdown
                End If
            End If
        Next i
    Else
        wsCopy.AutoFilterMode = False
    End If

Cleanup:
    Application.ScreenUpdating = True
    Exit Sub

ErrHandler:
    MsgBox "Bir hata oluştu: " & Err.Description, vbCritical
    Resume Cleanup
End Sub

Yanıtınız için teşekkür ederim. Kodu denedim, hata almadım fakat başarılı sonuç alamadım maalesef