makro ile yeni sayfa açma ve adlandırma

[gokhan_s]

iyi aksamlar arkadaşlar forumu aradım ama tam olarak istediğimi bulamadım;

"anasayfa" adında bir sayfam var ve bu sayfada aşağıdakine benzer bir tablom var:

isim	maaş
ahmet	300
mehmet	500
ali	800

yapmak istediğim; makroyu çalıştıracak tuşa bastığımda kaç adet isim varsa okadar yeni sayfa açılsın (yukarıdaki tablo için 3 adet yeni sayfa mesela), her sayfaya isimlerin adını versin(sayfa adları ahmet, mehmet, ali) ve sayfanın örnek olarak a1 hücresine maaşını yapıştırsın(ahmet sayfasına a1e 300, mehmet sayfasına a1e 500 gibi).

butonu koydum fakat makro kısmında acemi olduğumdan istediğimi elde edemedim.

yardım ederseniz sevinirim.

 

[vardar07]

Deneyiniz.

Sub sayfa()
    Dim sayfa As String, s1 As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
Set s1 = Sheets("anasayfa") 'verilerin olduğu sayfa adı
For i = 2 To s1.Range("A65536").End(3).Row
               sayfa = Cells(i, 1).Value
               If Not varmi(sayfa) Then
                   Sheets.Add After:=Worksheets(Worksheets.Count)
                   ActiveSheet.Name = sayfa
              End If
Sheets(sayfa).Cells(1, 1) = s1.Cells(i, 2)
Next
s1.Select
  Application.ScreenUpdating = True
End Sub
Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[gokhan_s]

merhaba

hata verdi ve debug dediğimde aşağıdaki kısmı sarı ile gösteriyor, ayrıca 1. sayfayı açıyor ve dogru ismi veriyor fakat 2. sayfaya isim veremedi hata burada oluyor sanırım;

Sub sayfa()
    Dim sayfa As String, s1 As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
Set s1 = Sheets("anasayfa") 'verilerin olduğu sayfa adı
For i = 2 To s1.Range("A65536").End(3).Row
               sayfa = Cells(i, 1).Value
               If Not varmi(sayfa) Then
                   Sheets.Add After:=Worksheets(Worksheets.Count)
                   [COLOR="yellow"]ActiveSheet.Name = sayfa[/COLOR]
              End If
Sheets(sayfa).Cells(1, 1) = s1.Cells(i, 2)
Next
s1.Select
  Application.ScreenUpdating = True
End Sub
Function varmi(adi As String) As Boolean
    On Error Resume Next
    varmi = CBool(Len(Worksheets(adi).Name) > 0)
End Function

 

[gokhan_s]

buarada şöyle bir uyarı veriyor bu makro kayıt aşamasında normal midir?

"dikkat belgenizin bazı bölümleri, belge denetçisi tarafından kaldırılamayan kişisel bilgiler içeriyor olabilir."

 

[vardar07]

Dosyanızı ekleyin bir bakalım. Benim kullandığım bir kod hiç hata yok.
Örnek dosya.

 

[gokhan_s]

merhaba çok teşekkürler, öncelikle mantığını anlayıp kendim uygulamaya çalıştım ama takıldım tabiki

tam olarak yapmak istediğim şey şu aslında;

ekteki dosyada görebileceğiniz üzere, YÜKLEMELER sayfasındaki firma sayısı kadar yeni sayfa açıp, örnekteki CAPLOG-KRONAR sayfasındaki taslaktaki E14 hücresine YÜKLEMELER sayfasındaki BL no başlığında firmaya denk gelen sayıyı yapıştırmak. Böylelikle yazdığım formüller sonucu kalan hesaplamayı kendi yapıyor taslak sayfası.


http://www.dosya.tc/server6/7nxmc4/fatura_taslak_makrolu_deneme.xlsx.html

 

[vardar07]

tam olarak yapmak istediğim şey şu aslında;

Tam olarak yapmak istediğiniz dosyanın örneğini baştan verseydiniz ne siz nede biz az yorulsaydık olmazmıydı.?

Dosyanızı Kontrol ediniz

 

[gokhan_s]

merhaba öncelikle ekteki dosya için teşekkürler çalışıyor.

sorunuza gelince, buradaki birçok insan gibi kendimi geliştirmeye ve bu kodları öğrenmeye çalışıyorum dolayısıyla temel olarak kod nasıl yazılır, nereye ne yazmam gerekiyor şeklinde başlangıçtan itibaren kendim gitmeye çalıştım, takıldığım yerde yardım almak daha iyi olur gibi düşündüm. yorduysam kusura bakmayın.