Birinci Listedeki verileri, ikinci listeye göre sıralama

[td877]

Arkadaşlar merhaba başlık biraz karışık oldu.

İşler ve Bölümler ismin iki sütunum var. İşler sütunumda 1-500 satırları arası değerler var. Bölümler sütunumda ise 1-100 satırları arası değerler var.

Benim yapmak istediğim şu: İşler ve bölümler sütunumda kaç değer varsa saydırmak. Bölümler sütunumdaki değerleri sıralama bozmadan, işler sütununundaki değer sayısı kadar alt alta kopyalamak. Kopyalanan verinin karşısından İşler sütunundaki değerleri tek tek yazmak.

örnek dosyam ektedir umarım anlaşılabilir olmuştur.

 

[Muzaffer Ali]

Merhaba.

Sayfanın adını sağ tıklatıp Kod Görüntüle seçin Aşağıdaki kodları açılan sayfaya kopyalayın ve çalıştırın.

Sub Test()
    Dim SayBolum As Integer
    Dim SayIsler As Integer
    Dim Bak As Integer
    Dim Say As Integer
    
    SayIsler = Cells(Rows.Count, "A").End(xlUp).Row
    SayBolum = Cells(Rows.Count, "B").End(xlUp).Row
    
    For Bak = 2 To SayIsler
        Say = Cells(Rows.Count, "H").End(xlUp).Row + 1
        Range("H" & Say & ":H" & (Say + SayBolum) - 2) = Cells(Bak, "A")
        Range("B2:B" & SayBolum).Copy Range("I" & Say)
    Next
End Sub

 

[td877]

Çok teşekkür ederim sayın dalgalikur.

 

[Muzaffer Ali]

Rica ederim iyi çalışmalar.