Yeniden listeleme

[velostar]

Ekli dosyada mevcut sayfasındaki listeyi hedef sayfasındaki gibi yeniden düzenlemeye çalışıyorum ancak neresinden başlayıp nasıl bir mantık yürüteceğimi bir türlü çözemedim. Yardımcı olabilir misiniz?

 

[apocalyt]

meraba,

bir module kopyalayıp deneyiniz.

Sub daylight()
Application.ScreenUpdating = False
Sheets(2).Range("a1:zz10000").ClearContents
For x = 2 To 50
Range(Cells(1, x), Cells(1000, x)).Copy
Sheets(1).Cells(Sheets(1).[zz1000].End(3).Row + 1, "zz").PasteSpecial
Next x
Sheets(1).Range("zz:zz").Sort key1:=Sheets(1).Range("zz2")
ben = Sheets(1).[zz1000].End(3).Row
For y = ben To 2 Step -1
If Sheets(1).Cells(y, "zz") = Sheets(1).Cells(y - 1, "zz") Then Sheets(1).Cells(y, "zz").Delete shift:=xlUp
Next y
Sheets(1).Range("zz1:zz" & Sheets(1).[zz1000].End(3).Row).Copy
Sheets(2).Range("a1").PasteSpecial Transpose:=True
Sheets(1).Range("zz:zz").ClearContents
sen = Sheets(2).Cells(1, 100).End(xlToLeft).Column
biz = Sheets(1).[a100000].End(3).Row
For Z = 1 To sen
For k = 1 To biz
If WorksheetFunction.CountIf(Sheets(1).Range(Sheets(1).Cells(k, 2), Sheets(1).Cells(k, 190)), Sheets(2).Cells(1, Z)) > 0 Then
Sheets(2).Cells(Sheets(2).Cells(10000, Z).End(3).Row + 1, Z) = Sheets(1).Cells(k, 1)
End If
Next k
Next Z
Application.ScreenUpdating = True
MsgBox "İşleminiz bitmiştir.", vbInformation
End Sub

 

[suleyman242]

Ekli dosyada mevcut sayfasındaki listeyi hedef sayfasındaki gibi yeniden düzenlemeye çalışıyorum ancak neresinden başlayıp nasıl bir mantık yürüteceğimi bir türlü çözemedim. Yardımcı olabilir misiniz?

Alternatif olarak yolluyorum