Liste oluşturmak

[ozgretmen]

Merhaba arkadaşlar;
Sorum ekte.Yardımlarınızı bekliyorum...
Saygılar...

 

[Orion1]

Dosya ekte.

Sub listele()
Dim sat As Long, i As Long, k As Byte
Range("J2:K65536").ClearContents
sat = 2
For i = 2 To Cells(65536, "B").End(xlUp).Row
        For k = 4 To 8
            If Cells(i, k).Value <> "" Then
                Cells(sat, "J").Value = Cells(i, "B").Value
                Cells(sat, "K").Value = Cells(i, k).Value
                sat = sat + 1
            End If
        Next k
Next i
End Sub

 

[ozgretmen]

Çok teşekkürler.

 

[Orion1]

Çok teşekkürler.

Rica ederim.