Boş satırlara sırasıyla personel atama

[tahsinanarat]

https://www.excel.web.tr/threads/gruplari-sirasiyla-dagitmak.178767/#post-982008
Yukarıdaki linkde daha evvelden Sn.ÖmerBey ve Sn.veyselemre hocam tarafından grupları sarasıyla dağıtma olayını yapmıştık. Kendilerine bir kez daha teşekkür ediyorum.

Şimdi yapmak istediğim dağıtımı yapılmış ancak işten ayrılma sebebiyle aralarda boş kalan dolapları doldurarak dağıtım işlemine devam etmesini istiyorum.
Detaylı açıklamayı örnek dosyamda yaptım. Yardımcı olacak arkadaşlarıma şimdiden teşekkür ederim.

 

[veyselemre]

Sub siraliGetir2()
    Dim col(1 To 4) As New Collection
    Set s1 = Sheets("PERSONEL")
    Set s2 = Sheets("Dolap_listesi")

    For i = 2 To s1.Cells(Rows.Count, "C").End(3).Row
        al = Asc(s1.Cells(i, 3).Value) - 64
        If al > 0 And al < 5 Then col(al).Add s1.Cells(i, 1).Resize(, 3).Value
    Next i

    For i = 1 To 4
        For ii = 1 To col(i).Count
            For iii = i + 1 To 10 ^ 5 Step 4
                If s2.Cells(iii, "D").Value = "" Then
                        s2.Cells(iii, "B").Resize(, 3).Value = col(i).Item(ii)
                        s2.Cells(iii, "B").Resize(, 3).Interior.Color = vbGreen
                        Exit For
                End If
            Next iii
        Next ii
    Next i
    Set col(1) = Nothing
    Set col(2) = Nothing
    Set col(3) = Nothing
    Set col(4) = Nothing
End Sub