Excel Otomatik Sayfa Oluşturma

[ErdemMH]

Excel A hücresinde yazılı olan yazılar ile aynı isimde sayfa oluşturma.

Arkadaşlar bu makroda bir çok sayfa oluşturacaksanız verilerin hepsini A satırna alt alta yazıyorsunuz ve makroyu çalıştırıyorsunuz makro otomatik sayfaları oluşturuyor.

Sub SayfaAc()
 
    Dim i As Long, Sa As Worksheet
 
    Set Sa = Sheets("AnaSayfa")
 
    Application.ScreenUpdating = False
    Sa.Select
 
    For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
         If Cells(i, "A") <> "" And Not varmi(Cells(i, "A")) Then
            Sheets.Add(After:=Sheets(Sheets.Count)).Name = Sa.Cells(i, "A")
            Sa.Select
        End If
    Next i
 
End Sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[victoriousayph]

Merhaba bu şekilde de olur mu hocam,

Sub SayfaAc()

Dim i As Long, Sa As Worksheet, ws As Worksheet

Set Sa = ThisWorkbook.Sheets("AnaSayfa")

Application.ScreenUpdating = False

For i = 1 To Sa.Cells(Rows.Count, "A").End(xlUp).Row
If Sa.Cells(i, "A").Value <> "" And Not VarMı(Sa.Cells(i, "A").Value) Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Sa.Cells(i, "A").Value
End If
Next i

Sa.Select
Application.ScreenUpdating = True

End Sub

Function VarMı(adi As String) As Boolean
On Error Resume Next
VarMı = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[#Adc Main]

Merhaba bu şekilde de olur mu hocam,

Sub SayfaAc()

Dim i As Long, Sa As Worksheet, ws As Worksheet

Set Sa = ThisWorkbook.Sheets("AnaSayfa")

Application.ScreenUpdating = False

For i = 1 To Sa.Cells(Rows.Count, "A").End(xlUp).Row
If Sa.Cells(i, "A").Value <> "" And Not VarMı(Sa.Cells(i, "A").Value) Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Sa.Cells(i, "A").Value
End If
Next i

Sa.Select
Application.ScreenUpdating = True

End Sub

Function VarMı(adi As String) As Boolean
On Error Resume Next
VarMı = CBool(Len(Worksheets(adi).Name) > 0)
End Function

Evet bu kodda herhangi bir belirgin hata yok gibi görünüyor kod "AnaSayfa" adlı çalışma sayfasına bağlı bu nedenle kodu kullanmadan önce bu sayfayı oluşturman gerekiyor ayrıca alt sayfaların adlarının excel'in maksimum sayfa adı uzunluğunu aşmadığından emin olman gerekiyor

 

[ErdemMH]

Merhaba bu şekilde de olur mu hocam,

Sub SayfaAc()

Dim i As Long, Sa As Worksheet, ws As Worksheet

Set Sa = ThisWorkbook.Sheets("AnaSayfa")

Application.ScreenUpdating = False

For i = 1 To Sa.Cells(Rows.Count, "A").End(xlUp).Row
If Sa.Cells(i, "A").Value <> "" And Not VarMı(Sa.Cells(i, "A").Value) Then
Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
ws.Name = Sa.Cells(i, "A").Value
End If
Next i

Sa.Select
Application.ScreenUpdating = True

End Sub

Function VarMı(adi As String) As Boolean
On Error Resume Next
VarMı = CBool(Len(Worksheets(adi).Name) > 0)
End Function

Olur tabi ki ve bunu test ederek görebilirsiniz.

Post automatically merged: 15 Mar 2023

Evet bu kodda herhangi bir belirgin hata yok gibi görünüyor kod "AnaSayfa" adlı çalışma sayfasına bağlı bu nedenle kodu kullanmadan önce bu sayfayı oluşturman gerekiyor ayrıca alt sayfaların adlarının excel'in maksimum sayfa adı uzunluğunu aşmadığından emin olman gerekiyor

Evet ilk sayfanın anasayfa olması lazım ya da sizin ne kullanıyorsanız kodda onu yapabilirsiniz.

 

[legendgamer161]

excel profesörü gibisiniz hayatıma kolaylık getirdiniz teşekkürler