İşaretli konu hücresini ilgili sekmeye atama hk.

[iaslan517]

Merhaba değerli form üyeleri,

Atama problemi konusunda yardımlarınıza ihtiyacım var. Ek'te yer alan excel sayfasında A Sütunundaki kalem numaralarını, B,C,D hücresinde işaretli ise ilgili sekmeye kalem numarasını atayacak makro konusunda yardımlarınızı rica ederim,

 

[veyselemre]

Sub test()
    Sheets("Sayfa1").Select
    Set Rng = Range("B2:E" & Cells(Rows.Count, 1).End(3).Row)
    If WorksheetFunction.CountA(Rng) = 0 Then Exit Sub
    For Each huc In Rng.SpecialCells(xlCellTypeConstants)
        Sheets(Cells(1, huc.Column).Value).Cells(Rows.Count, 1).End(3).Offset(1).Value = Cells(huc.Row, 1).Value
    Next
End Sub