Listedeki sıraya göre Sekmelere Otomatik isim verme

[Emidaf60]

Ekte yer alan dosyada her pozun adına bir sekme açılmasını istiyorum.Örnek vermek gerekirse alt sekmede İNŞ.ÖZL.10 diye bır sekme olacak sonra İNŞ.ÖZL.12 adında bır sekme olacak şekilde listedeki her poz adına bır sekme acmak istiyorum. Bunu kısa yoldan yapabileceğim bir yöntem varmı acaba?

 

[veyselemre]

Sub test()
    Dim r, sat, dic As Object, sName$
    Set dic = CreateObject("Scripting.Dictionary")
    For Each r In Worksheets
        dic(r.Name) = Null
    Next r
    With Sheets("Yaklaşık Maliyet")
        For Each r In .Range("C10:C" & .Cells(Rows.Count, 3).End(3).Row).Value
            If Not (r = "Poz No" Or r = "") Then
                sName = Replace(r, "/", "_")
                If Not dic.exists(sName) Then
                    dic(sName) = Null
                    Sheets.Add(after:=Sheets(Sheets.Count)).Name = sName
                End If
            End If
        Next r
    End With
End Sub

 

[Emidaf60]

Sub test()
    Dim r, sat, dic As Object, sName$
    Set dic = CreateObject("Scripting.Dictionary")
    For Each r In Worksheets
        dic(r.Name) = Null
    Next r
    With Sheets("Yaklaşık Maliyet")
        For Each r In .Range("C10:C" & .Cells(Rows.Count, 3).End(3).Row).Value
            If Not (r = "Poz No" Or r = "") Then
                sName = Replace(r, "/", "_")
                If Not dic.exists(sName) Then
                    dic(sName) = Null
                    Sheets.Add(after:=Sheets(Sheets.Count)).Name = sName
                End If
            End If
        Next r
    End With
End Sub

With Sheets satırında hata veriyor Veysel bey ne yapmam gerektıgı konusunda yardımcı olabılırsenız coksevınırım

 

[veyselemre]

Örneğiniz.