Hücrelerdeki değerler kadar sayfa oluşturma

[ruhadam26]

Merhabalar Üstadlar,
Üzerinde çalışmış olduğum excel çalışma kitabında icmal sayfasındaki butona basılınca Hazırlamış olduğum taslak sayfasından kopya oluşturarak (taslak sayfası yine kalacak yeni oluşacaklar sırayla oluşacak) A2 hücresinden aşağıya kadar dolu satır sayısı kadar ve A2den aşağıya hücrelerin içinde yazan metin adıyla birlikte sayfa oluşturmak istiyorum.
ÖRneğin. A2 de 1 a3 de 2 yazıyorsa 1 ve 2 adında iki ad sayfa oluşmasını istiyorum. (taslak sayfası yine sabit kalacak.Bu oluşan sayfalar exceli dosyası içerisindeki taslak sayfasını kopyası olup sadece sayfa ismi ilgili hücredeki isimler olacak. Bu hususta yardım ve desteklerinizi bekler iyi çalışmalar dilerim.

Örnek Dosya : https://www.dosya.tc/server40/1k92xh/Taseron_Hakedisi.xlsx.html

 

[ÖmerFaruk]

Forumda bu konuyla ilgili bir çok örnek var. Biraz inceleyin.
Arama menüsüne Şablon diye yazınca çıkan konuları araştırabilirsiniz.

 

[ruhadam26]

Forumda bu konuyla ilgili bir çok örnek var. Biraz inceleyin.
Arama menüsüne Şablon diye yazınca çıkan konuları araştırabilirsiniz.

Araştırdım forumda lakin kendi dosyama uyarlayamadım

 

[ruhadam26]

birde hocam altın üyeliğim sona erdiği için dosyaları indiremiyorum o yuzden iceleme yapma inkanım kısıtlı yeniden altın üye olma durumumda şu an için pek mümkün değil o yüzden yardımlarını bekliyor. Dosyayı dosya . tc bv. linklerseniz çok sevinirim.

 

[ÖmerFaruk]

Dosya yüklemeye gerek yok.
Aşağıdaki kodları VBA penceresinden bir modüle içine kopyalayınız.
İcmal sayfanızdaki butona Makro Ata diyerek bu yordamın adını atayınız.

Not: Kodlar her butona basışınızda (yada çalıştırdığınızda) İcmalde listelenen sayfalar daha önceden oluşturulmuşsa o sayfayı silecek kendisi tekrar yeniden oluşturacaktır.

Sub SayfaOluştur()
    Dim Sayfalar As Object, i As Integer, NewSheetName As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set Sayfalar = CreateObject("Scripting.Dictionary")
    For i = 1 To Sheets.Count
        Sayfalar.Add Sheets(i).Name, i
    Next i
    For i = 2 To Worksheets("İCMAL").Range("A" & Rows.Count).End(3).Row
        NewSheetName = Worksheets("İCMAL").Range("A" & i)
        If Sayfalar.Exists(NewSheetName) Then Worksheets(NewSheetName).Delete
        Worksheets("Taslak").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = NewSheetName
    Next i
    Worksheets("İCMAL").Activate
    Set Sayfalaer = Nothing: i = Empty: NewSheetName = vbNullString
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[ruhadam26]

Dosya yüklemeye gerek yok.
Aşağıdaki kodları VBA penceresinden bir modüle içine kopyalayınız.
İcmal sayfanızdaki butona Makro Ata diyerek bu yordamın adını atayınız.

Not: Kodlar her butona basışınızda (yada çalıştırdığınızda) İcmalde listelenen sayfalar daha önceden oluşturulmuşsa o sayfayı silecek kendisi tekrar yeniden oluşturacaktır.

Sub SayfaOluştur()
    Dim Sayfalar As Object, i As Integer, NewSheetName As String
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set Sayfalar = CreateObject("Scripting.Dictionary")
    For i = 1 To Sheets.Count
        Sayfalar.Add Sheets(i).Name, i
    Next i
    For i = 2 To Worksheets("İCMAL").Range("A" & Rows.Count).End(3).Row
        NewSheetName = Worksheets("İCMAL").Range("A" & i)
        If Sayfalar.Exists(NewSheetName) Then Worksheets(NewSheetName).Delete
        Worksheets("Taslak").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = NewSheetName
    Next i
    Worksheets("İCMAL").Activate
    Set Sayfalaer = Nothing: i = Empty: NewSheetName = vbNullString
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

oluşturma kısmı çok güzel şekilde çalışıyor hocam elinize sağlık. Yalnız icmalden bir satır sildiğimde tekrar oluştur dediğimde sildiğim satırın sayfasını siliyor ama en basa tekrardan sayfa olarak geliyor. Kac tane silersem en basa geliyor bir nevi silinme degilde tasinma gibi oluyor. sizin bu kodlara ilaveten taslak sayfası gozükmesin istediğimden onu başta gizliyip kodlar baslamadan gösterip geri gizlettiriyorum. bu sayfa silinmesi gerekirken taşınma işine bir çözüm bulabilirseniz çok sevinirim.

 

[ÖmerFaruk]

Önceki mesajımda zaten belirttim.
Not: Kodlar her butona basışınızda (yada çalıştırdığınızda) İcmalde listelenen sayfalar daha önceden oluşturulmuşsa o sayfayı silecek kendisi tekrar yeniden oluşturacaktır.

Siz silmesin mi istiyorsunuz?

 

[ruhadam26]

Önceki mesajımda zaten belirttim.
Not: Kodlar her butona basışınızda (yada çalıştırdığınızda) İcmalde listelenen sayfalar daha önceden oluşturulmuşsa o sayfayı silecek kendisi tekrar yeniden oluşturacaktır.

Siz silmesin mi istiyorsunuz?

Hayır hocam siliniyor ama geri geliyor silinsin istiyorum. İcmal sayfasındaki sıraya göre sıralansın istiyorum. mesela icmalde 5 satır var 5 sayfa oluşuyor icmalden 2 sayfa sildiğimde 3 sayfa yeniden oluşuyor ama o silinen 2 sayfa en başa geri geliyor onda sonra tekrar butona bastığımda icmali felan dasiliyor sapıtıyor ondan sonra

 

[ÖmerFaruk]

Şu şekilde kulllanın

Sub SayfaOluştur()
    Dim i As Integer, Sh As Worksheet
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each Sh In Worksheets
        If Sh.Name <> "İCMAL" And Sh.Name <> "TASLAK" Then Sh.Delete
    Next
    For i = 2 To Worksheets("İCMAL").Range("A" & Rows.Count).End(3).Row
        Worksheets("Taslak").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Worksheets("İCMAL").Range("A" & i)
    Next i
    Worksheets("İCMAL").Activate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[ruhadam26]

Şu şekilde kulllanın

Sub SayfaOluştur()
    Dim i As Integer, Sh As Worksheet
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    For Each Sh In Worksheets
        If Sh.Name <> "İCMAL" And Sh.Name <> "TASLAK" Then Sh.Delete
    Next
    For i = 2 To Worksheets("İCMAL").Range("A" & Rows.Count).End(3).Row
        Worksheets("Taslak").Copy After:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = Worksheets("İCMAL").Range("A" & i)
    Next i
    Worksheets("İCMAL").Activate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Elinize sağlık çok teşekkür ederim. Şuan için gayet iyi bir şekilde çalışmakta.