Düşeyara Makrosu ve Renk Koduna Göre Sıralama

[jinken]

Ekli dosyamda c2 satırındaki değere göre diğer verileri eklemiş olduğum butonlar ile çekmesini istiyorum. Daha sonra renk koduna göre sıralama yapmasını.

 

[Emir Hüseyin Çoban]

. . .

Cari Kod Butonu için

Sub kod_carikodu()
Application.ScreenUpdating = False

Dim S1 As Worksheet, S2 As Worksheet
Dim i, a
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("liste")
S1.Range("A2:B65536").ClearContents
S1.Range("D2:F65536").ClearContents

For i = 2 To S1.[C65536].End(3).Row
For a = 2 To S2.[A65536].End(3).Row

If S1.Cells(i, "C") = S2.Cells(a, "A") Then
S1.Cells(i, "A") = S2.Cells(a, "F")
S1.Cells(i, "B") = S2.Cells(a, "D")
S1.Cells(i, "D") = S2.Cells(a, "C")
S1.Cells(i, "E") = S2.Cells(a, "B")

Else: End If
Next a
Next i

Application.ScreenUpdating = False
MsgBox " B i t t i "
End Sub

. . .

A sütunu için

Sub kod_A_sirala()
son = Sheets("Sayfa1").[C65536].End(3).Row
Range("A2:E" & son).Sort Key1:=[B]Range("A2")[/B], Order1:=xlAscending, Header:=xlNo
End Sub

B sütunu için

Sub kod_B_sirala()
son = Sheets("Sayfa1").[C65536].End(3).Row
Range("A2:E" & son).Sort Key1:=[B]Range("B2")[/B], Order1:=xlAscending, Header:=xlNo
End Sub

Diğerlerini siz yapabilirsiniz.

. . .

 

[jinken]

Teşekkür ederim birazdan Türkiye maçını izleyeceğim daha sonra deneyeceğim çok teşekkür ederim.