Nasıl yapılır-başka sayfaya aktarma

[senerozun]

Aşagıdaki ekte gönderdigim belgemi makro ile nasıl yapabilirim. Şimdiden teşekkürler

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub düzenle()
Dim toplam1 As Double, toplam2 As Double
Dim sat As Long, s2sat As Long, k As Byte, deg As String
If Sheets("SAYFA 1").Cells(65536, "A").End(xlUp).Row < 2 Then Exit Sub
Application.ScreenUpdating = False
Sheets("SAYFA 1").Select

sat = 4
s2sat = 4
Set s2 = Sheets("BU HALE GETİRMEK İSTİYORUM")
s2.Range("A4:P65536").ClearContents
Do While sat <= Cells(65536, "A").End(xlUp).Row
deg = Cells(sat, "A").Value
    Do While deg = Cells(sat, "A").Value
        For k = 1 To 17
            s2.Cells(s2sat, k).Value = Cells(sat, k).Value
        Next
        toplam1 = toplam1 + Cells(sat, "N").Value
        toplam2 = toplam2 + Cells(sat, "P").Value
        sat = sat + 1
        s2sat = s2sat + 1
    Loop
    s2.Cells(s2sat, "L").Value = "TOPLAM"
    s2.Cells(s2sat, "N").Value = toplam1
    s2.Cells(s2sat, "P").Value = toplam2
    s2sat = s2sat + 2
    toplam1 = 0
    toplam2 = 0
Loop
s2.Select
Set s2 = Nothing
Application.ScreenUpdating = True
MsgBox "İŞLEM TAMAMLANDI..!!", vbOKOnly + vbInformation, Application.UserName
End Sub