Excel Yazdırma Seçeneği

[ankoyuncu]

Merhaba,

30.000 satır bir listem mevcut. Bu listeyi yazdırmak istediğimde her isim için ayrı bir sayfada yazdırmak istiyorum. Örneğin 1-31 satırları arasında Ali Can ismi var. Alican ile ilgili bilgiler 1 sayfaya yazdırılacak. 32-40 satırlarında Ayşe Yılmaz var bu yeni bir sayfa yazdırılması gerekiyor. Böyle birşey mümkün müdür?
Destekleriniz için teşekür ederim.

 

[BaY_KaPTaN]

Merhaba.
Aşağıdaki kodu denermisiniz_?

Sub SayfalaraVeriAktarveYazdır()
    Dim ky, s1 As Worksheet, son&
    Set s1 = Sheets("Anasayfa")
    son = s1.Cells(Rows.Count, 1).End(3).Row
    With CreateObject("Scripting.Dictionary")
        For Each ky In s1.Range("A2:A" & son).Value
            If ky <> "" And Not .Exists(ky) Then
                .Item(ky) = Null
                If Evaluate("ISREF('" & ky & "'!A1)") = False Then
                    Sheets.Add(, Sheets(Sheets.Count)).Name = ky
                Else
                    Sheets(ky).Cells.Clear
                End If
            End If
        Next ky
        s1.Select
        For Each ky In .Keys
            s1.Range("A1:F1").AutoFilter Field:=1, Criteria1:=ky
            s1.Range("A1:F" & son).Copy Sheets(ky).Range("A1")
            Sheets(ky).Columns.AutoFit
        Next ky
        s1.Range("A1:F1").AutoFilter
    End With
    
    ' Veri olan sayfaları yazdırır
    Dim wc As Integer
    For wc = 1 To ThisWorkbook.Worksheets.Count
      ThisWorkbook.Worksheets(wc).PrintOut
    Next wc
End Sub