sayfalara sıralama

[m_turker]

merhaba;

akbank 20 kg mal 30 tl den 600 tl
garanti 10 kg mal 20 tlden 200 tl
işbank 5 kg mal 10 tlden 50 tl

gibi banka isimleri farklılık gösteren bir listem var.. ama farklı birer sayfada her bankaya özel işlemleri görmek istiyorum.. mesela akbank sayfasına akbankın tüm işlemleri garanti sayfasına garanti bankasının tüm işlemlerinin aktarılmasını istiyorum..

listemin başlıkları aşağıdaki ektedir. ilgilenirseniz memnun kalırım..

 

[Ömer]

Merhaba,

Module kopyalayıp çalıştırın.

Sub Dagit()
 
    Dim j As Integer, i As Long, sayfa As String, son As Long
 
    Application.ScreenUpdating = False
 
    Application.DisplayAlerts = False
    For j = Worksheets.Count To 1 Step -1
        With Sheets(j)
            If .Name <> "liste" Then
                .Delete
            End If
        End With
    Next j
    Application.DisplayAlerts = True
 
    With Sheets("liste")
        For i = 4 To .Cells(Rows.Count, "C").End(xlUp).Row
            If Cells(i, "C") <> "" Then
               sayfa = Trim(.Cells(i, "C"))
               If Not varmi(sayfa) Then
                   Sheets.Add After:=Worksheets(Worksheets.Count)
                   ActiveSheet.Name = sayfa
                   .Select
               End If
               .Range("A1:I3").Copy Sheets(sayfa).Range("A1")
                son = Sheets(sayfa).Cells(Rows.Count, "C").End(xlUp).Row + 1
               .Range("A" & i & ":I" & i).Copy Sheets(sayfa).Range("A" & son)
            End If
        Next i
    End With
 
    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

.