iki kodu birleştirme

[talatcd]

Private Sub CommandButton8_Click()
Sheets("EBildirge").Select
Range("A2:I1000").Select
Selection.ClearContents
-----------------------------------------

Private Sub CommandButton9_Click()
Set s1 = Sheets("Parametre")
Set s2 = Sheets("EBildirge")
a = Array(1, 2, 3, 4, 13, 24, 19, 20, 21)
sat = 1
For x = 2 To [a65536].End(3).Row
If Cells(x, 24) > 0 Then
sat = sat + 1
For y = 1 To 9
s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
Next
End If
Next x
a = Array(5, 6)
For y = 0 To 1
s2.Cells(sat + 1, a) = WorksheetFunction.Sum(Range(s2.Cells(2, a), s2.Cells(sat, a)))
Next
Sheets("EBildirge").Range("B65536").End(xlUp).Offset(1, 0).Value = "TOPLAM" 'En Son Satıra TOPLAM yazmak
End Sub

Arkadaşlar Bu iki kodu birleştirmek istiyorum. Yardımcı olursanız sevinirim.

 

[xxcell]

Private Sub CommandButton9_Click()
Set s1 = Sheets("Parametre")
Set s2 = Sheets("EBildirge")
a = Array(1, 2, 3, 4, 13, 24, 19, 20, 21)
sat = 1
For x = 2 To [a65536].End(3).Row
If Cells(x, 24) > 0 Then
sat = sat + 1
For y = 1 To 9
s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
Next
End If
Next x
a = Array(5, 6)
For y = 0 To 1
s2.Cells(sat + 1, a(y)) = WorksheetFunction.Sum(Range(s2.Cells(2, a(y)), s2.Cells(sat, a(y))))
Next
Sheets("EBildirge").Range("B65536").End(xlUp).Offs et(1, 0).Value = "TOPLAM" 'En Son Satıra TOPLAM yazmak
[COLOR="Red"]s2.Select
Range("A2:I1000").Select
Selection.ClearContents[/COLOR]
End Sub

Commandbutton9'a clickleyince iki işlemide yapacak şekilde birleştirildi.

 

[talatcd]

xxcell emeğiniz için teşekkür ederim fakat benim istediğim şu eski verileri silip yenileri yazacak, senin vermiş olduğun kodda listeleyip siliyor. Yapmak istediğim Eski ayın verilerini silip üzerine yeni verileri yazması

 

[AS3434]

O zaman baş kısma alacaksınız....

Private Sub CommandButton9_Click()
Set s1 = Sheets("Parametre")
Set s2 = Sheets("EBildirge")
[COLOR="Red"]s2.Select
[A2:I1000].ClearContents[/COLOR]
a = Array(1, 2, 3, 4, 13, 24, 19, 20, 21)
sat = 1
For x = 2 To [a65536].End(3).Row
If Cells(x, 24) > 0 Then
sat = sat + 1
For y = 1 To 9
s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
Next
End If
Next x
a = Array(5, 6)
For y = 0 To 1
s2.Cells(sat + 1, a(y)) = WorksheetFunction.Sum(Range(s2.Cells(2, a(y)), s2.Cells(sat, a(y))))
Next
Sheets("EBildirge").Range("B65536").End(xlUp).Offs et(1, 0).Value = "TOPLAM" 'En Son Satıra TOPLAM yazmak

End Sub

 

[talatcd]

Teşekkürler arkadaşlar bazı hatalar vardı biraz da ben düzelttim tam kod aşağıdadır. Arkadaşlara yardımcı olur diye kodu gönderiyorum.

Private Sub CommandButton9_Click()
Set s1 = Sheets("Parametre")
Set s2 = Sheets("EBildirge")
s2.Select
[A2:I1000].ClearContents
s1.Select
a = Array(1, 2, 3, 4, 13, 24, 19, 20, 21)
sat = 1
For x = 2 To [a65536].End(3).Row
If Cells(x, 24) > 0 Then
sat = sat + 1
For y = 1 To 9
s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
Next
End If
Next x
a = Array(5, 6)
For y = 0 To 1
s2.Cells(sat + 1, a) = WorksheetFunction.Sum(Range(s2.Cells(2, a), s2.Cells(sat, a)))
Next
Sheets("EBildirge").Range("B65536").End(xlUp).Offset(1, 0).Value = "TOPLAM"

End Sub