Sayfa İsmine göre Kayıt

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
372
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Merhaba ekteki dosyada evrak kayıt etmek istiyorum. evrak farklı firmalardan geliyor benim her firmaya bir sayfa oluşturmam gerekiyor. Sayfayı manuel de oluşturabilirim ama girdiğim veriyi her sayfaya kayıt etmesini istiyorum. Örneğin 22 sayfasına sadece 22 isimli firmadan gelen evrakı kayıt etmem gerekiyor. eğer sayfa ismi yoksa uyarı vermeli.
Forumda aradım bulamadım örnek, köprü mantığı ile yapmak istedim onuda yapamadım. örnek uygulama varsa oradanda tasarlayabilirim.
Yardımlarınız için teşekkür ederim.

 

Ekli dosyalar

asi_kral

Özel Üye
Katılım
22 Şubat 2012
Mesajlar
2,822
Excel Vers. ve Dili
Excel 2007 Türkçe
Merhaba
Boş bir module ekleyip dener misiniz?
Kod:
Sub evrak()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR As Long, HT As Long, STR1 As Long
Set S1 = Sheets("Evrak Kayıt")
Set S2 = Sheets("şablon")
For HT = 1 To Sheets.Count
S1.Range("Z" & HT) = Sheets(HT).Name
Next
If WorksheetFunction.CountIf(S1.Range("Z:Z"), S1.Range("B8")) > 0 Then
Set S3 = Sheets(S1.Range("B8").Text)
STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
If STR < 5 Then STR = 5
S3.Range("B" & STR) = S1.Range("B5")
S3.Range("C" & STR) = S1.Range("B6")
S3.Range("D" & STR) = S1.Range("B7")
S3.Range("E" & STR) = S1.Range("B8")
S3.Range("F" & STR) = S1.Range("B9")
Else
S2.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = S1.Range("B8").Text
Set S3 = Sheets(S1.Range("B8").Text)
STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
If STR < 5 Then STR = 5
S3.Range("B" & STR) = S1.Range("B5")
S3.Range("C" & STR) = S1.Range("B6")
S3.Range("D" & STR) = S1.Range("B7")
S3.Range("E" & STR) = S1.Range("B8")
S3.Range("F" & STR) = S1.Range("B9")
End If
S1.Range("Z:Z").Clear
End Sub
 

asi_kral

Özel Üye
Katılım
22 Şubat 2012
Mesajlar
2,822
Excel Vers. ve Dili
Excel 2007 Türkçe
Teşekkür ederim.
Kendi adınıza Şehit yakınları için bağış yapabilirsiniz.
 

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
372
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Merhaba
Boş bir module ekleyip dener misiniz?
Kod:
Sub evrak()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR As Long, HT As Long, STR1 As Long
Set S1 = Sheets("Evrak Kayıt")
Set S2 = Sheets("şablon")
For HT = 1 To Sheets.Count
S1.Range("Z" & HT) = Sheets(HT).Name
Next
If WorksheetFunction.CountIf(S1.Range("Z:Z"), S1.Range("B8")) > 0 Then
Set S3 = Sheets(S1.Range("B8").Text)
STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
If STR < 5 Then STR = 5
S3.Range("B" & STR) = S1.Range("B5")
S3.Range("C" & STR) = S1.Range("B6")
S3.Range("D" & STR) = S1.Range("B7")
S3.Range("E" & STR) = S1.Range("B8")
S3.Range("F" & STR) = S1.Range("B9")
Else
S2.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = S1.Range("B8").Text
Set S3 = Sheets(S1.Range("B8").Text)
STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
If STR < 5 Then STR = 5
S3.Range("B" & STR) = S1.Range("B5")
S3.Range("C" & STR) = S1.Range("B6")
S3.Range("D" & STR) = S1.Range("B7")
S3.Range("E" & STR) = S1.Range("B8")
S3.Range("F" & STR) = S1.Range("B9")
End If
S1.Range("Z:Z").Clear
End Sub

Sayın hocam bu kodda evrak kayıt sayfasında b8 satırına bir formül yazdığımda kayıt yapıyor fakat sayfa ismini değiştirmiyor. şablon olarak kayıt yapıyor.
 

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
372
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Nerede hata yapıyorum. Makro konusunda tecrübeli üstatlar yardımcı olabilir mi?
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Sayın hocam bu kodda evrak kayıt sayfasında b8 satırına bir formül yazdığımda kayıt yapıyor fakat sayfa ismini değiştirmiyor. şablon olarak kayıt yapıyor.
Nasıl bir formülden bahsediyorsunuz? Dosyanızı o haliyle paylaşır mısınız?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,246
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kod içindeki aşağıdaki iki satır şablon sayfasını kopyaladıktan sonra isminide değştiriyor gibi görünüyor.

S2.Copy after:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = S1.Range("B8").Text
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Nerde nasıl bir işlem yapıldığında nasıl bir sonuç beklerken nasıl bir sonuç alıyorsunuz? Yani sorunun ayrıntılı açıklaması nedir?
 

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
372
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Nerde nasıl bir işlem yapıldığında nasıl bir sonuç beklerken nasıl bir sonuç alıyorsunuz? Yani sorunun ayrıntılı açıklaması nedir?
Kusura bakmayın 5. ci mesajda yazınca tekrar yazmayı unutmuşum. normal de iş no: satırını manuel giriyordum. Kaydet dediğimde eğer iş no ile ilgili bir sayfa varsa kayıt yapıyor yoksa şablonu kullanarak iş no ya yazdığım verinin ismiyle bir satır oluşturuyor. Başka bir sayfadan b8 satırına formül oluşturdum artık oluşturmuyor. eklediğim tabloda formülü kaldırdım fakat yine oluşturmuyor. kodları tekrar oluşturdum yapamadım. teşekkürler
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu dener misiniz?

PHP:
Sub evrak()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR As Long, HT As Long, STR1 As Long
Set S1 = Sheets("Evrak Kayıt")
Set S2 = Sheets("şablon")
S1.Range("Z:Z").Clear
islem = "Yok"
For sayfa = 1 To Sheets.Count
    If Sheets(sayfa).Name = S1.[B8].Text Then
        islem = "Var"
        Set S3 = Sheets(sayfa)
    End If
Next
If islem = "Var" Then
    STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
    If STR < 5 Then STR = 5
    S3.Range("B" & STR) = S1.Range("B5")
    S3.Range("C" & STR) = S1.Range("B6")
    S3.Range("D" & STR) = S1.Range("B7")
    S3.Range("E" & STR) = S1.Range("B8")
    S3.Range("F" & STR) = S1.Range("B9")
    Exit Sub
Else
    S2.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = S1.Range("B8").Text
    Set S3 = Sheets(S1.Range("B8").Text)
    STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
    If STR < 5 Then STR = 5
    S3.Range("B" & STR) = S1.Range("B5")
    S3.Range("C" & STR) = S1.Range("B6")
    S3.Range("D" & STR) = S1.Range("B7")
    S3.Range("E" & STR) = S1.Range("B8")
    S3.Range("F" & STR) = S1.Range("B9")
End If
End Sub
 

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
372
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Aşağıdaki makroyu dener misiniz?

PHP:
Sub evrak()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim STR As Long, HT As Long, STR1 As Long
Set S1 = Sheets("Evrak Kayıt")
Set S2 = Sheets("şablon")
S1.Range("Z:Z").Clear
islem = "Yok"
For sayfa = 1 To Sheets.Count
    If Sheets(sayfa).Name = S1.[B8].Text Then
        islem = "Var"
        Set S3 = Sheets(sayfa)
    End If
Next
If islem = "Var" Then
    STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
    If STR < 5 Then STR = 5
    S3.Range("B" & STR) = S1.Range("B5")
    S3.Range("C" & STR) = S1.Range("B6")
    S3.Range("D" & STR) = S1.Range("B7")
    S3.Range("E" & STR) = S1.Range("B8")
    S3.Range("F" & STR) = S1.Range("B9")
    Exit Sub
Else
    S2.Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = S1.Range("B8").Text
    Set S3 = Sheets(S1.Range("B8").Text)
    STR = S3.Range("B" & Rows.Count).End(xlUp).Row + 1
    If STR < 5 Then STR = 5
    S3.Range("B" & STR) = S1.Range("B5")
    S3.Range("C" & STR) = S1.Range("B6")
    S3.Range("D" & STR) = S1.Range("B7")
    S3.Range("E" & STR) = S1.Range("B8")
    S3.Range("F" & STR) = S1.Range("B9")
End If
End Sub
Şablon olarak oluşturuyor. Yapması gereken b8 deki değere göre sayfa ismi vermesi gerekiyor. varsa olan sayfaya kayıt yoksa yeni sayfa. Eğer sizde çalışıyorsa ekler misiniz?
 

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
372
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
Altın Üyelik Bitiş Tarihi
18-01-2027
Yeni bir kitap oluşturdum. burada yaptı. ama daha önceki tablomda oluşturmadı. ilginç. ilginiz için teşekkür ederim.
 
Üst