toplu sekme oluşturma

[cuneytturkoglu]

Merhabalar ,

Elimde 41 satırdan oluşan ana bir veri var. Bu 41 satırın belirtilen örnek format şeklinde 41 adet sekmede göstermem gerekiyor. Örnek formatı ekte paylaşıyorum. Yardımlarınızı bekliyorum..

http://www.dosya.tc/server11/1uuz9l/siparis_form.xls.html

 

[Haluk]

Merhaba;

Aşağıdaki kodu deneyebilirsiniz,

Sub CreateSheets()
    Dim MySh As Worksheet, NewSh As Worksheet
    Set MySh = Sheets("ANA SAYFA")
    NoA = MySh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To NoA
        Application.DisplayAlerts = False
        Sheets(MySh.Range("A" & i).Text).Delete
        Application.DisplayAlerts = True
        Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count))
        NewSh.Name = MySh.Range("A" & i)
        NewSh.Range("A2:L3").Value = MySh.Range("A2:L3").Value
        NewSh.Range("B2") = MySh.Range("A" & i)
        NewSh.Range("A4:K4").Value = MySh.Range("B" & i & ":L" & i).Value
        NewSh.Columns.AutoFit
    Next
End Sub

 

[cuneytturkoglu]

Sheets(MySh.Range("A" & i).Text).Delete burası hata veriyor..

 

[Haluk]

"ANA SAYFA" dışındaki sayfaları manuel olarak silip, kodu öyle deneyin bir kere de ...


.

 

[Haluk]

Ya da bunu deneyin;

Sub CreateSheets()
    Dim MySh As Worksheet, NewSh As Worksheet
    Set MySh = Sheets("ANA SAYFA")
    NoA = MySh.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 4 To NoA
        On Error Resume Next
        Application.DisplayAlerts = False
        Sheets(MySh.Range("A" & i).Text).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0
        Set NewSh = Worksheets.Add(After:=Sheets(Sheets.Count))
        NewSh.Name = MySh.Range("A" & i)
        NewSh.Range("A2:L3").Value = MySh.Range("A2:L3").Value
        NewSh.Range("B2") = MySh.Range("A" & i)
        NewSh.Range("A4:K4").Value = MySh.Range("B" & i & ":L" & i).Value
        NewSh.Columns.AutoFit
    Next
End Sub