Poz nosuna göre koşullu sayfa ekleme

[alirizapekbilir]

Merhaba
sayfamızda daha önce buna benzer konuda yardım istemiş ve çok kısa sürede çözüme ulaşmıştım. Şimdi
ay sonları hakediş yapabilmem için veriler geliyor. ben verilerimi yapılan işler sayfasına kayıt ediyorum. burada bir makro oluşturmak istiyorum. "poz aç" butonuna bastığım anda;
1 o poz ismi ile yeni bir tane sayfa açacak
2 sayfayı oluştururken "sabit" sayfası içerisinde bulunan tabloyu yapıştıracak
3 yeni oluşturduğu sayfanın sarı ile boyalı yerlerine poz adı, işin adı ve birimi
kutucuklarınıda yazmasını istiyorum.

Makro konusunda hiç bir bilgim olmamakla birlikte bu işin ancak makrolar yardımı ile yapılabileceğini düşünüyorum.
Şimdiden ellerinize ve emeğinize sağlık.

 

[Emir Hüseyin Çoban]

. . .

Açıklamada eksiklik var gibi..

YAPILAN İŞLER sayfasında kaç tane poz no varsa o kadar sayfa mı açılacak yoksa her zaman 1 tane mi olur.

Sayfada daha önce sayfası olan Poz No olabilir mi.

. . .

 

[alirizapekbilir]

. . .

Açıklamada eksiklik var gibi..

YAPILAN İŞLER sayfasında kaç tane poz no varsa o kadar sayfa mı açılacak yoksa her zaman 1 tane mi olur.

Sayfada daha önce sayfası olan Poz No olabilir mi.

. . .

Günaydın hocam.
"Yapılan İşler" sayfasında kaç tane poz no varsa o kadar sayfa açılması gerek. Eğer o poz numarası ile daha önce bir sayfa varsa yeniden bir sayfa oluşturmayacak.

 

[Emir Hüseyin Çoban]

. . .

Sub Kod()
    Dim Sayfa As String
    Dim S1 As Worksheet: Set S1 = Sheets("YAPILAN İŞLER")

    For a = 5 To S1.Cells(Rows.Count, "B").End(3).Row
        Sayfa = S1.Cells(a, "B")
        If Not SayfaVarMi(Sayfa) Then
            Sheets("SABİT").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = S1.Cells(a, "B")
            Range("D4") = S1.Cells(a, "B")
            Range("D5") = S1.Cells(a, "C")
            Range("I5") = S1.Cells(a, "D")
        End If
    Next a

End Sub

Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function

Ekran Görüntüsü:


. . .

 

[alirizapekbilir]

. . .

Sub Kod()
    Dim Sayfa As String
    Dim S1 As Worksheet: Set S1 = Sheets("YAPILAN İŞLER")

    For a = 5 To S1.Cells(Rows.Count, "B").End(3).Row
        Sayfa = S1.Cells(a, "B")
        If Not SayfaVarMi(Sayfa) Then
            Sheets("SABİT").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = S1.Cells(a, "B")
            Range("D4") = S1.Cells(a, "B")
            Range("D5") = S1.Cells(a, "C")
            Range("I5") = S1.Cells(a, "D")
        End If
    Next a

End Sub

Function SayfaVarMi(Sayfa As String) As Boolean
    On Error Resume Next
    SayfaVarMi = CBool(Len(Worksheets(Sayfa).Name) > 0)
End Function

Ekran Görüntüsü:


. . .

ellerinize ve emeğinize sağlık

 

[alirizapekbilir]

ellerinize ve emeğinize sağlık

Hocam yeni karşılaştığım bir sorunu aktarıyorum. poz no ların içinde : /\ gibi ifadeler var ve olacak bunları kabul etmiyor. yani yeni sayfalar oluştururken hata veriyor.

 

[Emir Hüseyin Çoban]

. . .

Bu Windows ve Excel' in izin vermediği bir durum.
Bu karakterler ile isim veremesiniz.
Bu karakterleri yok sayabilirsiz, yerine tire (- _ ) gibi başka karakter veya boşluk bırakabiliriz.



. . .

 

[alirizapekbilir]

Hocam tekrar merhaba
excel benim istediğimi yapsaydı çok iyi olacaktı ama çokta sorun değilmiş açıkcası bende sıra numarasına göre kodları düzenledim. ama bu seferde formülleri bozdu. bi bakma sansınız varmı dosya ektedir.

 

[Emir Hüseyin Çoban]

. . .

Bu yasaklı karakterler yerine # gibi bir joker kullanarabiliriz ve
formüllerde ilave yaparak araması gereken veri MSB.304\A iken MSB.304#A aramasını sağlayabiliriz.
Zaten mevcut formüllerinizde buna benzer bir işlem var.
Sizin Formülünüz: =EĞER($B6="";"";DOLAYLI("'"&YERİNEKOY($B6;"/";" ";1)&"'!"&"D5"))

. . .

 

[alirizapekbilir]

. . .

Bu yasaklı karakterler yerine # gibi bir joker kullanarabiliriz ve
formüllerde ilave yaparak araması gereken veri MSB.304\A iken MSB.304#A aramasını sağlayabiliriz.
Zaten mevcut formüllerinizde buna benzer bir işlem var.
Sizin Formülünüz: =EĞER($B6="";"";DOLAYLI("'"&YERİNEKOY($B6;"/";" ";1)&"'!"&"D5"))

. . .

Hocam Merhaba
yapmış olduğunuz makro çalışırken "?""/" gibi karekterleri görmeyip bunları boşluk olarak algılayıp sayfa eklemesini sağlayabilirmiyiz.

 

[Emir Hüseyin Çoban]

.

Yeni açılan sayfalarda Poz no: yani D4 hücresinede bu karakterler olmayan ismi yazmasını istiyorsanız kırmızı ile belirttiğim yere Sayfa yazın..

Sub Kod()
    Dim Sayfa As String
    Dim S1 As Worksheet: Set S1 = Sheets("YAPILAN İŞLER")

    For a = 5 To S1.Cells(Rows.Count, "B").End(3).Row
        Sayfa = Replace(Replace(Replace(S1.Cells(a, "B"), "?", " "), "/", " "), "\", " ")
        If Not SayfaVarMi(Sayfa) Then
            Sheets("SABİT").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = Sayfa
            Range("D4") = [COLOR="DarkRed"]S1.Cells(a, "B")[/COLOR]
            Range("D5") = S1.Cells(a, "C")
            Range("I5") = S1.Cells(a, "D")
        End If
    Next a
End Sub

.