Filtreleme ve yenilenen değer

[igultekin2000]

iyi günler;
F sütununa göre firma ismine göre filtreleme yapıyorum. Bu durumda B sütununda çıkan firmaları YENİLENEN DEĞER olarak FORM çalışma sayfasının A sütununa almak istiyorum. Yenilenen değer olarak kullandığım makro vardı ancak filtrelemede yeterli olmuyor, makroya nasıl bir ilave yaparak kullanabilirim. Teşekkür ederim. Formda Filtreleme ve Yenilenen değer olarak aradım ancak bulamadım.

Sub yenilenen_DURUM()
Application.ScreenUpdating = False
On Error Resume Next
Set S1 = ThisWorkbook.Worksheets("hücre")
Set S2 = ThisWorkbook.Worksheets("FORM")
S2.Range("a2:a65536").ClearContents
S2.Range("a2:d65536").Borders.LineStyle = xlNone

For i = 3 To S1.Range("b65536").End(xlUp).Row
If WorksheetFunction.CountIf(S1.Range("B14:B" & i), S1.Cells(i, "B")) = 1 Then
sonsatir = S2.Range("A65536").End(xlUp).Row + 1
S2.Cells(sonsatir, 1) = S1.Cells(i, 2)
S2.Range("a" & sonsatir & ":d" & sonsatir).Borders.LineStyle = xlContinuous 'kenar çizgisi oluşturmak
End If
Next i

Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation

End Sub

Filtreleme 14.cü satırdan başlıyor.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Unique_List()
    Dim S1 As Worksheet, S2 As Worksheet
    
    Set S1 = Sheets("hücre1")
    Set S2 = Sheets("FORM")
    
    S1.Range("B2:B" & S1.Cells(S1.Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible).Copy S2.Range("A1")
    S2.Range("A1:A" & S2.Cells(S2.Rows.Count, 1).End(3).Row).RemoveDuplicates Columns:=1, Header:=xlNo
    S2.Range("A1:A" & S2.Cells(S2.Rows.Count, 1).End(3).Row).Sort S2.Range("A1"), Header:=xlNo

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[igultekin2000]

Sorunsuz çalışıyor, elinize sağlık, teşekkür ederim. İyi çalışmalar.