makro ile firma isimlerine göre 80 yeni sayfa açmak

[gezgin-49]

Sayın üstadlarım elimdeki dosyada "Sayfa1" sayfasında B2:B81 arasında 80 adet firma ismi A2:A81 hücrelerinde ise bu firmalara ait cari kod numaraları mevcut aynı dosyada "Sayfa2" deki formatı kopyala yapıştır yöntemiyle çoğaltılmasını ve yeni açılan bu sayfaların ayrı ayrı A1 hücresine firma isimlerinin ayrı ayrı yazılması gerekiyor. dosya ekte, bu hususta yardımlarınızı bekliyorum. hepinize saygılar sunuyorum.

 

[Necdet]

Merhaba,

Bir inceleyiniz, bakalım olmuş mu?

Sub Sayfa_Olustur()
Set s1 = Sheets("Sayfa1")
For i = 2 To s1.[B65536].End(3).Row
    Sheets("Sayfa2").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.[A1] = s1.Cells(i, "B")
    ActiveSheet.Name = s1.Cells(i, "B")
Next i
MsgBox "Sayfalar Açılmıştır.....", vbOKCancel, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

 

[gezgin-49]

Sayın üstadım müthişsiniz, Allah razı olsun, ellerinize emeğinize sağlık

 

[Necdet]

Sayın Gezgin,

Güle güle kullanınız.

 

[Necdet]

Tekrar Merhaba,

Hataları önlemek açısından kodu aşağıdaki gibi kullanılması sanırım daha iyi olacaktır.

Hem ikinci kere çalıştırılmasında hem de aynı sayfa adından olup olmadığını kontrolü için daha elverişli kodlar.

Sub Sayfa_Olustur()
Dim Durum As Boolean
Dim i, j As Double
Set s1 = Sheets("Sayfa1")
For i = 2 To s1.[B65536].End(3).Row
    Durum = False
    
    '--------- Sayfa isminin olup olmadığının kontrolu ------
    For j = 3 To Sheets.Count
        If Sheets(j).Name = s1.Cells(i, "B") Then
            Durum = True
        Exit For
        End If
    Next j
    '--------- Sayfa kontrolu Sonu --------------------------
    
    If Durum = False Then
        Sheets("Sayfa2").Copy After:=Sheets(Sheets.Count)
        ActiveSheet.[A1] = s1.Cells(i, "B")
        ActiveSheet.Name = s1.Cells(i, "B")
    End If
Next i
s1.Select
MsgBox "Sayfalar Açılmıştır.....", vbOKCancel, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

 

[gezgin-49]

sayın üstadım teşekkür ederim. ellerinize sağlık

 

[mulk]

örnek dosyayı görüntüleyemiyorum yardımcı olabilirmisiniz