Advancedfilter ile tablo sayfasındaki benzersizleri sayfa1 b sütuna satır olarak yapı

[hsayar]

Advancedfilter ile tablo sayfasındaki benzersizleri sayfa1 b sütuna satır olarak yapıştırma?


aşağıdaki kodlardaki 5. satır tablo sayfasındaki benzersizleri süzüp sayfa1 b sütununun son satının 2 altına Sütun olarak yapıştırıyor.
2005
2006
2007
vs...


peki 5. satırda kullanılmış olan Advanced filter ile süzülen tablo sayfasındaki benzersizleri süzüp sayfa1 b sütununun son satının 2 altına Satır olarak yapıştır denilebilirmi
2005 2006 2007 vs....
şeklinde

Sub ButceYıl_TutarDag()
1  Dim shT, shR As Worksheet
2  Set shR = Sheets("Sayfa1"): Set shT = Sheets("TABLOM")

'Tablo sayfasının A Sütunundan benzersiz Bütçe yıllarını al _
     Bu sayfadaki B sütuna, Edeki son satırı kontrol ederek _
     benzersizleri yapıştır.
3  sonsat_Tbl = shT.Cells(65536, "A").End(3).Row
4  sonsat_Rpr = shR.Cells(65536, "E").End(3).Row
5  shT.Range("A1:A" & sonsat_Tbl).AdvancedFilter , Action:=xlFilterCopy, CopyToRange:= _
   shR.Range("B" & sonsat_Rpr + 2), Unique:=True

end sub

 

[kulomer46]

aşağıdaki kodlar işinize yarayabilir..
Sub ButceYıl_TutarDag()
Dim shT, shR As Worksheet
Set shR = Sheets("Sayfa1"): Set shT = Sheets("Sayfa2")

sonsat_Tbl = shT.Cells(65536, "A").End(3).Row
Sonsat_Rpr = shR.Cells(65536, "A").End(3).Row
shT.Range("A1:A" & sonsat_Tbl).AdvancedFilter , Action:=xlFilterCopy, CopyToRange:= _
shR.Range("A" & Sonsat_Rpr + 2), Unique:=True
Range("A" & sonsat_Tbl + 2 & ":A" & Cells(65500, 2).End(xlUp).Row).Copy
Range("B" & Sonsat_Rpr + 2).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
'Range("A:A").ClearContents
End Sub

 

[hsayar]

sn kulomer46 öncelikle alakanız teşekkür ederim
ancak Advanced filterın kendi transpose özelliği olsa ve ya
hücre yerine benzersiz kayıtları diziye alsa ve kayıt sayısı kadar belirttiğim sütundan itibaren sütunlar, 3. satır değerine sıra ile yazsın.

 

[hsayar]

  shT.Range("A1:A200").AdvancedFilter , Action:=xlFilterCopy, CopyToRange:= _
   shR.Range("A2"), Unique:=True

Yukarıda ki kodlar Tabl sayfasının a1:a200 hücre aralığındaki benzersiz kayıtları rapor sayfasının
b2 hücresine (b2, b3, ................ b10 vs.) yapıştırır
peki Geçici hücre kullanmadan direkt olarak
b2 hücresine (c2, d2,e2 ................ h2 vs.) şeklinde yapıştırmanın yolu varmıdır? pastespecila tranpse = true gibi