Aynı bilgileri yazdırmasın

[svtcsn]

Arkadaşlar ekteki gibi bir form düzenledim fakat yazdırma sorununu aşamadım
yazdır ikonuna bastıgım zaman 1 defa sevket 1 defa salih bilgilerini yazmasını istiyorum fakat kaç satır salih/sevket varsa o kadar yazıyor bu sıkıntıyı nasıl aşabilirim

 

[Necdet]

Merhaba,

Kodları aşağıdaki gibi kullanınız.

Sub otomatik_yazdir()
Dim i As Long
Dim eskiad As String
For i = 2 To Sheets("kisiler").Range("a65536").End(3).Row
    If eskiad <> Sheets("kisiler").Cells(i, "A").Value & Sheets("kisiler").Cells(i, "B").Value Then
        Sheets("matbu form").Range("b25").Value = Sheets("kisiler").Cells(i, 1).Value
        Sheets("matbu form").PrintPreview '
        eskiad = Sheets("kisiler").Cells(i, "A").Value & Sheets("kisiler").Cells(i, "B").Value
    End If
Next i
End Sub

 

[Orion1]

Dosyanız ektedir.

Sub otomatik_yazdir()
Dim i As Long, sat As Long, k As Range, adr As String, sat2 As Long
sat2 = Sheets("kisiler").Cells(65536, "A").End(xlUp).Row
For i = 2 To Sheets("kisiler").Range("a65536").End(3).Row
    If WorksheetFunction.CountIf(Sheets("kisiler").Range("A2:A" & i), Sheets("kisiler").Cells(i, "A").Value) = 1 Then
        Sheets("matbu form").Range("A8:E16,B25:B29").ClearContents
        sat = 8
        Sheets("matbu form").Cells(25, "B").Value = Sheets("kisiler").Cells(i, "A").Value
        Sheets("matbu form").Cells(26, "B").Value = Sheets("kisiler").Cells(i, "B").Value
        Sheets("matbu form").Cells(27, "B").Value = Sheets("kisiler").Cells(i, "C").Value
        Sheets("matbu form").Cells(28, "B").Value = Sheets("kisiler").Cells(i, "E").Value
        Sheets("matbu form").Cells(29, "B").Value = Sheets("kisiler").Cells(i, "D").Value
        Set k = Sheets("kisiler").Range("A" & i & ":A" & sat2).Find(Sheets _
        ("kisiler").Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                Sheets("matbu form").Cells(sat, "A").Value = Sheets("kisiler").Cells(k.Row, "G").Value
                Sheets("matbu form").Cells(sat, "B").Value = Sheets("kisiler").Cells(k.Row, "H").Value
                Sheets("matbu form").Cells(sat, "C").Value = Sheets("kisiler").Cells(k.Row, "I").Value
                sat = sat + 1
                Set k = Sheets("kisiler").Range("A" & i & ":A" & sat2).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
        Sheets("matbu form").PrintPreview '
    End If
Next i
End Sub

 

[svtcsn]

arkadaşlar harikasınız ya çook teşekkür ederim hepinize
ÇOOOOK ÇOOOOK SAĞOLUN HEPİNİZ

 

[svtcsn]

Dosyanız ektedir.

Sub otomatik_yazdir()
Dim i As Long, sat As Long, k As Range, adr As String, sat2 As Long
sat2 = Sheets("kisiler").Cells(65536, "A").End(xlUp).Row
For i = 2 To Sheets("kisiler").Range("a65536").End(3).Row
    If WorksheetFunction.CountIf(Sheets("kisiler").Range("A2:A" & i), Sheets("kisiler").Cells(i, "A").Value) = 1 Then
        Sheets("matbu form").Range("A8:E16,B25:B29").ClearContents
        sat = 8
        Sheets("matbu form").Cells(25, "B").Value = Sheets("kisiler").Cells(i, "A").Value
        Sheets("matbu form").Cells(26, "B").Value = Sheets("kisiler").Cells(i, "B").Value
        Sheets("matbu form").Cells(27, "B").Value = Sheets("kisiler").Cells(i, "C").Value
        Sheets("matbu form").Cells(28, "B").Value = Sheets("kisiler").Cells(i, "E").Value
        Sheets("matbu form").Cells(29, "B").Value = Sheets("kisiler").Cells(i, "D").Value
        Set k = Sheets("kisiler").Range("A" & i & ":A" & sat2).Find(Sheets _
        ("kisiler").Cells(i, "A").Value, , xlValues, xlWhole)
        If Not k Is Nothing Then
            adr = k.Address
            Do
                Sheets("matbu form").Cells(sat, "A").Value = Sheets("kisiler").Cells(k.Row, "G").Value
                Sheets("matbu form").Cells(sat, "B").Value = Sheets("kisiler").Cells(k.Row, "H").Value
                Sheets("matbu form").Cells(sat, "C").Value = Sheets("kisiler").Cells(k.Row, "I").Value
                sat = sat + 1
                Set k = Sheets("kisiler").Range("A" & i & ":A" & sat2).FindNext(k)
            Loop While Not k Is Nothing And k.Address <> adr
        End If
        Sheets("matbu form").PrintPreview '
    End If
Next i
End Sub

sayın evren bey ilginiz için teşekkür ederim fakat yazdığınız kodda tutar kısmını almıyor bi kontrol edermisiniz.
teşekkürler