DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Filtrele_Yaz()
Dim i As Integer, son As Integer
With Sayfa1
.Range("K1:K50").ClearContents
.Range("B5:B304").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=.Range("K1"), Unique:=True
.Range("K1").Select
Selection.Delete Shift:=xlUp
.AutoFilterMode = False
For i = 1 To .Range("K65536").End(3).Row
.[B4].AutoFilter field:=2, Criteria1:=.Cells(i, "K")
.[A1].CurrentRegion.Copy Sayfa2.Range("A1")
With Sayfa2
son = .Range("H65536").End(3).Row
.PageSetup.PrintArea = "$A$1:$H$" & son
'.PrintOut Copies:=1
Sayfa2.Range("A1:H300").ClearContents
End With
Next i
.AutoFilterMode = False
End With
son = Empty: i = Empty
End Sub
Murat Bey işinize kolaylaştıracağını düşündüğüm dosyayı tekrar gönderiyorum. Filtrelenecek köyler K sütunda hazır;
Buna göre ; listeden o köyleri filtreleyip 2 nüsha yazılımını makro ile gerçekleştirebilirmiyiz. İlginizden dolayı teşekkürler