makroya sıralama kodu eklenmesi

[kemal turan]

Merhaba ustadlar.
Aşağıdaki kod sayfa 1 A sutunundaki hücre seçimi ile sayfa 2 B sutunundan
verileri süzüyor.
Sorun; süzülen veriler sayfa 1 b sutununda b2 den başlayarak alt alta değil dağınık şekilde gösteriyor.
Sutundaki veriler arasında boş satılar var.
Bu boşlukların olmamasını, B2 den itibaren aşağıya doğru sıralanmasını sağlayabilirmiyiz.(sıralama alfabetik olursa ala olur.)
Yardımlarınızı bekliyorum.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
c = 0
If Not Intersect(Target, [a2:a65536]) Is Nothing Then
[b2:c65536].ClearContents
If Target = "" Then Exit Sub
For a = 2 To [sayfa2!a65536].End(3).Row
If Sheets("sayfa2").Cells(a, "a") = Target Then
c = c + 1
If WorksheetFunction.CountIf([b:b], Sheets("sayfa2").Cells(a, "b")) = 0 Then
Cells(c + 1, "b") = Sheets("sayfa2").Cells(a, "b")
End If
End If
Next
End If
End Sub

 

[kemal turan]

Korhan ustad,
Çözüm hususunda yardımlarınızı rica ediyorum.
Yoksa isteğim mümkün değil mi ?
Tşk.

 

[paranormal]

Korhan ustad,
Çözüm hususunda yardımlarınızı rica ediyorum.
Yoksa isteğim mümkün değil mi ?
Tşk.

Ricaniz basim üstüne, asagiya yazdigim kod isinizi görmesi lazim. Yalniz ben hücreyi A dan N ye kadar yazdim siz kendinize göre ince ayar yaparsiniz, kolay gelsin.


Private Sub_Test()
Dim SonSatir As Long
Set WF = WorksheetFunction
SonSatir = WF.CountA(Range("A:A")) - 1
On Error Resume Next
For Counter = 1 To SonSatir
Range("N" & Counter).Value = Counter - 0
Range("A:N").Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Next Counter
END SUB

 

[kemal turan]

Sn.Paranormal cevabınız için teşekkür ederim.
Fakat bir şey anlamadım.
Yanlış anlattığımdan olabilir, anlayamadığım.
Ek dosyaya bir bakarmısınız isteğimin daha açık anlaşılabilir olduğunu düşüyorum.
Saygılar

 

[baydeniro]

Çok teşekkürler

 

[kemal turan]

Problemimiz başka bir soru başlığında Sn.Levent bey tarafından çözülmüştür.
İlgilenen herkese çok teşekkür ederim