Makro ile ile hücreye değer yapıştırmak

[magnet2014]

Merhaba,

Aşağıdaki makro kodu kullanıyorum. Ancak çalıştırdığımda çıkan liste özet isimli sayfanın b9 hücresinden başlayarak yapışıtırıyor. Ben b25 hücresinden başlayarak yapıştırmasını istiyorum. Kod da nasıl bir düzeltme yapmam lazım Yardımlarınız için teşekkür ederim.

Sub bütçe_asimi()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Özet").Range("b1065536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Özet")
For i = 2 To s1.Range("A65536").End(xlUp).Row
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
For k = 4 To s2.Range("n65536").End(xlUp).Row
If s2.Cells(k, "n") < 0 Then
sonsatir = s1.Range("b65536").End(xlUp).Row + 1
s1.Cells(sonsatir, 2) = sonsatir - 9
For Z = 2 To 14
s1.Cells(sonsatir, Z + 1) = s2.Cells(k, Z)
Next Z
s1.Cells(sonsatir, 16) = s1.Cells(i, 1)
End If
Next k
Next i
Application.ScreenUpdating = True
MsgBox "Rapor Sonu", vbInformation
End Sub

 

[PLİNT]

Merhaba,

Aşağıdaki makro kodu kullanıyorum. Ancak çalıştırdığımda çıkan liste özet isimli sayfanın b9 hücresinden başlayarak yapışıtırıyor. Ben b25 hücresinden başlayarak yapıştırmasını istiyorum. Kod da nasıl bir düzeltme yapmam lazım Yardımlarınız için teşekkür ederim.

Merhaba
Aşağıdaki kırmızı bölümleri değiştirerek/ekleyerek deneyiniz;

Sub bütçe_asimi()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Özet").Range("[COLOR="Red"]b25:[/COLOR]O65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Özet")
For i = 2 To s1.Range("A65536").End(xlUp).Row
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
For k = 4 To s2.Range("n65536").End(xlUp).Row
If s2.Cells(k, "n") < 0 Then
sonsatir = s1.Range("b65536").End(xlUp).Row + 1
[COLOR="Red"]If sonsatir < 25 Then sonsatır = 25[/COLOR]
s1.Cells(sonsatir, 2) = sonsatir [COLOR="Red"]- 24[/COLOR]
For Z = 2 To 14
s1.Cells(sonsatir, Z + 1) = s2.Cells(k, Z)
Next Z
s1.Cells(sonsatir, 16) = s1.Cells(i, 1)
End If
Next k
Next i
Application.ScreenUpdating = True
MsgBox "Rapor Sonu", vbInformation
End Sub

 

[magnet2014]

Merhaba
Aşağıdaki kırmızı bölümleri değiştirerek/ekleyerek deneyiniz;

Sub bütçe_asimi()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Özet").Range("[COLOR="Red"]b25:[/COLOR]O65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Özet")
For i = 2 To s1.Range("A65536").End(xlUp).Row
Set s2 = ThisWorkbook.Worksheets(s1.Cells(i, 1).Value)
For k = 4 To s2.Range("n65536").End(xlUp).Row
If s2.Cells(k, "n") < 0 Then
sonsatir = s1.Range("b65536").End(xlUp).Row + 1
[COLOR="Red"]If sonsatir < 25 Then sonsatır = 25[/COLOR]
s1.Cells(sonsatir, 2) = sonsatir [COLOR="Red"]- 24[/COLOR]
For Z = 2 To 14
s1.Cells(sonsatir, Z + 1) = s2.Cells(k, Z)
Next Z
s1.Cells(sonsatir, 16) = s1.Cells(i, 1)
End If
Next k
Next i
Application.ScreenUpdating = True
MsgBox "Rapor Sonu", vbInformation
End Sub

Plint hayat kurtarırsın Teşekkürler????????