Koşullu yeni sayfalar oluşturma

[gnorar]

Selamlar;
A sutununda malzemelerin B sütununda da malzeme stok sayılarının bulunduğu onbinlerce satırlık bir tablom var. Yapmak istediğim stoğu bulunan herbir malzemenin adını kullanan üç ayrı sayfa oluşturmak. Sayfa adları; 1. Sayfa adı: Malzeme adı+stok, 2. sayfa adı Malzeme adı+talep, 3 sayfa adı Malzeme adı+onay şeklinde oluşturulacak. Bir malzemenin adı bir çok satırda geçmekte olup, o malzemeye ait sadece 1 defa yukarda anlattığım sayfalar oluşturulacak.

Anlatması biraz zor oldu. Bu nedenle içerisinde açıklama olan örnek bir tablo ekledim.
Yardımcı olursanız sevinirim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub SAYFA_KOPYALA()
    Dim Hücre As Range, Son_Satır As Long
    
    Application.ScreenUpdating = False
    
    Son_Satır = Sheets("Sayfa1").Range("A65536").End(3).Row
    
    For Each Hücre In Sheets("Sayfa1").Range("A2:A" & Son_Satır)
        If Hücre.Value <> "" And Hücre.Offset(0, 1).Value <> "" Then
            On Error Resume Next
            If CBool(Len(Worksheets(Hücre.Text & " Stok").Name) > 0) = False Then
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = Hücre.Text & " Stok"
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = Hücre.Text & " Talep"
                Sheets.Add After:=Sheets(Sheets.Count)
                ActiveSheet.Name = Hücre.Text & " Onay"
            End If
            On Error GoTo 0
        End If
    Next
 
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[gnorar]

Sn. Korhan Ayhan, hazırladığınız makro doğru olarak çalışmaktadır. (Şunu itiraf etmeliyim ki makronun bu işi nasıl yaptığını anlayamadım.) Teşekkür ederim.