excelde adet girdiğim satırın ayrı bir sayfada ve ya bir butonla a4 yazdırma

[Emir Hüseyin Çoban]

. . .

Sub KOD_İKİ()
Application.ScreenUpdating = False
'
Dim s3 As Worksheet
Dim s1 As Worksheet
Dim s2 As Worksheet
Set s2 = Sheets("sayfa2")
Set s1 = Sheets("sayfa1")
Set s3 = Sheets("sayfa3")
aa = s1.[b65536].End(3).Row - 3
ab = 6
iki = s3.[d65536].End(3).Row + 1
'
s3.Range("a6:d" & iki).ClearContents
s3.Range("a6:d" & iki).Font.Bold = False
s3.Range("a6:d" & iki).Borders.LineStyle = xlNone
'
s3.Range("a1") = "Sayın ; " & s2.Range("b2") & " " & s2.Range("b3")
s3.Range("a2") = "Adres : " & s2.Range("b4")
s3.Range("a3") = "Tel : " & s2.Range("b6") & "  Mail: " & s2.Range("b5")
'
For i = 3 To aa
If s1.Cells(i, 3) <> "" Then
s3.Cells(ab, 1) = s1.Cells(i, 1)
s3.Cells(ab, 2) = s1.Cells(i, 2)
s3.Cells(ab, 3) = s1.Cells(i, 3)
s3.Cells(ab, 4) = s1.Cells(i, 4)
ab = ab + 1
Else
End If
Next i
'
ac = s1.[b65536].End(3).Row
ad = s3.[b65536].End(3).Row + 1
dd = s3.[d65536].End(3).Row
'
s3.Cells(ad, 2) = s1.Cells(ac - 2, 2)
s3.Cells(ad, 4) = s1.Cells(ac - 2, 4)
s3.Cells(ad + 1, 2) = s1.Cells(ac - 1, 2)
s3.Cells(ad + 1, 3) = s1.Cells(ac - 1, 3)
s3.Cells(ad + 1, 4) = s1.Cells(ac - 1, 4)
s3.Cells(ad + 2, 2) = s1.Cells(ac, 2)
s3.Cells(ad + 2, 4) = s1.Cells(ac, 4)
'
s3.Range("b" & ad & ":b" & ad + 2).Font.Bold = True
s3.Range("d" & ad & ":d" & ad + 2).Font.Bold = True
s3.Range("b" & ad & ":b" & ad + 2).Borders.Weight = xlThin
s3.Range("d" & ad & ":d" & ad + 2).Borders.Weight = xlThin
s3.Range("a6:" & "d" & dd).Borders.Weight = xlThin
'
onn = s3.[c65536].End(3).Row + 1
hh = s3.[a65536].End(3).Row
s3.Range("c" & onn).ClearContents
'
s3.Columns("B:B").EntireColumn.Hidden = True
s3.Columns("d:d").EntireColumn.Hidden = True
s3.Range("a1:e" & hh).PrintOut
s3.Columns("B:B").EntireColumn.Hidden = False
s3.Columns("d:d").EntireColumn.Hidden = False
'
Application.ScreenUpdating = True
End Sub

. . .

 

[nightscreen]

. . .

Sub KOD_İKİ()
Application.ScreenUpdating = False
'
Dim s3 As Worksheet
Dim s1 As Worksheet
Dim s2 As Worksheet
Set s2 = Sheets("sayfa2")
Set s1 = Sheets("sayfa1")
Set s3 = Sheets("sayfa3")
aa = s1.[b65536].End(3).Row - 3
ab = 6
iki = s3.[d65536].End(3).Row + 1
'
s3.Range("a6:d" & iki).ClearContents
s3.Range("a6:d" & iki).Font.Bold = False
s3.Range("a6:d" & iki).Borders.LineStyle = xlNone
'
s3.Range("a1") = "Sayın ; " & s2.Range("b2") & " " & s2.Range("b3")
s3.Range("a2") = "Adres : " & s2.Range("b4")
s3.Range("a3") = "Tel : " & s2.Range("b6") & "  Mail: " & s2.Range("b5")
'
For i = 3 To aa
If s1.Cells(i, 3) <> "" Then
s3.Cells(ab, 1) = s1.Cells(i, 1)
s3.Cells(ab, 2) = s1.Cells(i, 2)
s3.Cells(ab, 3) = s1.Cells(i, 3)
s3.Cells(ab, 4) = s1.Cells(i, 4)
ab = ab + 1
Else
End If
Next i
'
ac = s1.[b65536].End(3).Row
ad = s3.[b65536].End(3).Row + 1
dd = s3.[d65536].End(3).Row
'
s3.Cells(ad, 2) = s1.Cells(ac - 2, 2)
s3.Cells(ad, 4) = s1.Cells(ac - 2, 4)
s3.Cells(ad + 1, 2) = s1.Cells(ac - 1, 2)
s3.Cells(ad + 1, 3) = s1.Cells(ac - 1, 3)
s3.Cells(ad + 1, 4) = s1.Cells(ac - 1, 4)
s3.Cells(ad + 2, 2) = s1.Cells(ac, 2)
s3.Cells(ad + 2, 4) = s1.Cells(ac, 4)
'
s3.Range("b" & ad & ":b" & ad + 2).Font.Bold = True
s3.Range("d" & ad & ":d" & ad + 2).Font.Bold = True
s3.Range("b" & ad & ":b" & ad + 2).Borders.Weight = xlThin
s3.Range("d" & ad & ":d" & ad + 2).Borders.Weight = xlThin
s3.Range("a6:" & "d" & dd).Borders.Weight = xlThin
'
onn = s3.[c65536].End(3).Row + 1
hh = s3.[a65536].End(3).Row
s3.Range("c" & onn).ClearContents
'
s3.Columns("B:B").EntireColumn.Hidden = True
s3.Columns("d:d").EntireColumn.Hidden = True
s3.Range("a1:e" & hh).PrintOut
s3.Columns("B:B").EntireColumn.Hidden = False
s3.Columns("d:d").EntireColumn.Hidden = False
'
Application.ScreenUpdating = True
End Sub

. . .

hüseyin bey çok teşekkürler...yapmak istediğimizi elde ettik...bir sorum olacak... istediğim kadar satır ekleyip ürün girebilirmiyim?yardımlarınız için tekrar çok teşekkür ederim...