Banka firmaların, ayrı sayfalarda gösterilmesi

[1903emre34@gmail.com]

Merhabalar,

B sütünda ki banka firmaların isimlerini, hesap koduna göre (300,400) ayrı sayfalarda gözükmesini istiyorum, para birimlerin ayrı sayfalarda gözükmesini istemiyorum (sarı işaretli olan kısımlar) nasıl kod oluşturabiliriz

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u dener misiniz?

Not:
-- Verilerinizin bulunduğu sayfanın adı Sayfa1 olmalıdır,
-- Sayfa ismine ilişkin karakter sayısı sorunu nedeniyle isimlendirmede kısaltmalar kullanıldı.
-- Belgenizde Sayfa1 adını taşımayan tüm sayfalar silineceğinden, işlem öncesi belgenizin bir kopyasını alın.
.

[B]Sub BANKA_SAYFALARI_BRN()[/B]
Set s1 = Sheets("Sayfa1"): Set wf = Application.WorksheetFunction
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
For s = Sheets.Count To 1 Step -1
    If Sheets(s).Name <> "Sayfa1" Then Sheets(s).Delete
Next
Application.DisplayAlerts = True
s1.Columns("H:H").Insert Shift:=xlToRight
son = s1.Cells(Rows.Count, 1).End(3).Row
s1.Range("A1:H1").AutoFilter
With s1.Range("H2:H" & son)
[COLOR="Blue"]    .Formula = "=IF(OR(AND(LEFT(A2,3)=""300"",LEN(A2)>11),AND(LEFT(A2,3)=""400"",LEN(A2)>9))," & _
                "LEFT(A2,3)&"" ""&TRIM(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(IFERROR(LEFT(B2," & _
                "FIND(""-"",B2,1)-1),B2),""BANKASI "",""B. ""),""KATILIM "",""K. "")" & _
                ",""KREDİ KARTI"",""K.KAR""),""TÜRKİYE"",""T."")),"""")"[/COLOR]
    .Calculate: .Value = .Value
End With
For sat = 2 To son
    If WorksheetFunction.CountIf(s1.Range("H1:H" & sat), s1.Cells(sat, "H")) = 1 Then
        s1.Range("A1:H1").AutoFilter Field:=8, Criteria1:=s1.Cells(sat, "H")
    isim = s1.Cells(sat, "H")
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = isim: s1.Range("A1:H1").Copy ActiveSheet.[A1]
    s1.Range("A2:G" & son).SpecialCells(xlCellTypeVisible).Copy ActiveSheet.[A2]
    s1.Range("A1:H1").AutoFilter Field:=8
    ActiveSheet.Columns("A:G").ColumnWidth = 37.43: ActiveSheet.Columns("A:G").EntireColumn.AutoFit
    ActiveSheet.Cells.EntireRow.AutoFit: s1.Activate
    End If
Next
s1.Columns("H:H").Delete Shift:=xlToLeft
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem Tamamlandı..", vbInformation, "..:: Ö. BARAN ::.."
[B]End Sub[/B]

 

[1903emre34@gmail.com]

Üstad; çok teşekkürler, ellerinize sağlık.

 

[1903emre34@gmail.com]

Merhaba,

Mesaj gönderdikten sonra, 300 hesap koduyla bir husus fark ettim;

Kodlar; 400_hesabında yer alan firmaları, güzel bir şekilde ayrı sayfalara gösteriyor, ama 300_hesabında yer alan Türkiye Finans, KuveytTurk, Albaraka TurK banka kuruluşları sayfalarda gösterilmiyor, size zahmet bakabilir misiniz?

 

[Ömer BARAN]

Merhaba.

Önceki kod'da güncelleme yaptım (mavi renklendirdim).
Sayfayı yenileyerek kontrol edin.
Yeni haliyle sorun olmaması lazım.
.

 

[1903emre34@gmail.com]

Tamam, sağ olun

Hayırlı geceler

 

[Ömer BARAN]

Kolay gelsin.
.