• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sayfa İsmine göre Kayıt

H

hasankardas

Altın Üye
Katılım
14 Ağustos 2006
Mesajlar
519
Excel Vers. ve Dili
Ofis 2021ProPlus TR 64 Bit
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.

dosyam.org

Bilgi

Bilgi
dosyam.org dosyam.org
 

Ekli dosyalar

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
 
Teşekkür ederim.
Kendi adınıza Şehit yakınları için bağış yapabilirsiniz.
 
asi_kral' Alıntı:
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
Genişletmek için tıkla ...


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.
 
Nerede hata yapıyorum. Makro konusunda tecrübeli üstatlar yardımcı olabilir mi?
 
hasankardas' Alıntı:
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.
Genişletmek için tıkla ...
Nasıl bir formülden bahsediyorsunuz? Dosyanızı o haliyle paylaşır mısınız?
 
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
 
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?
 
YUSUF44' Alıntı:
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?
Genişletmek için tıkla ...

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
 
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
 
YUSUF44' Alıntı:
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
Genişletmek için tıkla ...

Ş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?
 
Yeni bir kitap oluşturdum. burada yaptı. ama daha önceki tablomda oluşturmadı. ilginç. ilginiz için teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst