DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Hesapla01()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sheets(1)
Set alan1 = S1.Range("H[b]6[/b]:H40")
Set alan3 = S1.Range("A[b]6[/b]:A40")
alan3.ClearContents
alan1.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=alan3, Unique:=True
Application.ScreenUpdating = True
End Sub