hücredeki değere göre sheetlere gruplandırma yapma

[sırakaya]

Merhabalar;

Örnekte liste bölümüne yapıştırdığım müşterileri yetki kodlarına göre sheetlere toplamak istiyorum. genel listedeki rut-111 deki müşterileri rut-111 shhetinde toplamak istiyorum. Yardımlarınızı rica ederim. İyi günler

 

[Ömer]

Merhaba,

Linki inceleyiniz.

http://excel.web.tr/f48/verilere-gore-sayfa-sayfa-ayyrma-t95084.html

.

 

[sırakaya]

Ömer Bey merhaba;

Öncelikle teşekkür ederim. Vermiş olduğunuz linkteki kodu uyguladım çalıştı,bir kaç sorum daha olacak,bu işlemi makrosuz formülle uygulayabilir miyim, makrolu şekliyle alt toplamları nasıl her sheete atabilirim. İyi günler.

 

[Ömer]

Formülle de yapılabilir, yalnız veri ve sayfa çokluğuna göre dosyanızı kasar.

Sub Sayfalara_Dagit()
    
    Dim Sl As Worksheet, d As Object, i As Long, a1
    Dim deg As String, son As Long, son1 As Long, son2 As Long
    
    Set d = CreateObject("Scripting.Dictionary")
    Set Sl = Sheets("Liste")
    son = Sl.Cells(Rows.Count, "C").End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    For i = 2 To son
        deg = Sl.Cells(i, "C")
        If Not d.exists(deg) Then
            d.Add deg, Nothing
        End If
    Next i
    
    a1 = d.keys
    For i = 0 To d.Count - 1
        If Not varmi("" & a1(i) & "") Then
            Sheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = a1(i)
        End If
        Sl.Range("A1:D" & son).AutoFilter Field:=3, Criteria1:=a1(i)
        With Sheets("" & a1(i) & "")
            .Cells.Clear
            son1 = Sl.Cells(Rows.Count, "C").End(xlUp).Row
            Sl.Range("A1:D" & son1).Copy .Range("A1")
            son2 = .Cells(Rows.Count, "C").End(xlUp).Row
            .Range("C" & son2 + 1) = "Toplam"
            .Range("D" & son2 + 1) = "=sum(D2:D" & son2 & ")"
            .Range("A:D").EntireColumn.AutoFit
        End With
    Next i
    
    Sl.Range("A1:D" & son).AutoFilter
    Application.ScreenUpdating = True

End Sub

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

.

 

[sırakaya]

Ömer bey teşekkür ederim yardımlarınız için, sorunsuz bir şekilde çalışıyor. Formül ile de yöntemini örnek dosya ile paylaşırsanız eğer büyük bir iyilik yapmış olursunuz. İyi akşamlar..

 

[Ömer]

Konuyla ilgili linki inceleyiniz.

http://www.excel.web.tr/f122/sayfalara-formulle-suzme-t19886.html

.

 

[sırakaya]

Ömer Bey, yardımlarınız için teşekkür ederim. Çok işime yaradı. İyi günler dilerim..