j sutunudaki boş olanları sıralanmış olarak aktarma

[yellow]

arkadaşlar sorumu aşağıdaki dosyada belirtim.şimdiden ilgilenen arkadaşlara teşekkür ederim.

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub AKTAR()
Dim S1, S2 As Worksheet
Dim SUT, S As Integer
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
S2.[A2:J1000].Clear
For SUT = 1 To S1.Cells(65536, "A").End(3).Row
If S1.Cells(SUT, "J") = "" Then
Range(S1.Cells(SUT, "A"), S1.Cells(SUT, "J")).Copy
S = S + 1
S2.Cells(S + 1, "A").PasteSpecial
End If
Next
Application.CutCopyMode = False
S2.Select
[A2:J1000].Sort KEY1:=[A2], Order1:=xlAscending
Set S1 = Nothing
Set S2 = Nothing
End Sub

 

[yellow]

Sayin N.zİya HİÇdurmaz EmeĞİnİze SaĞlik Çok GÜzel OlmuŞ Çok TeŞekkÜr Ederİm.

 

[N.Ziya Hiçdurmaz]

Bişey değil.