Boş bırakmadan yazma

[mehmethoca]

DefInt A, I, S
Sub MehmetHoca()
Range("a17:ab46").ClearContents
On Error Resume Next
son = 30
sut = Cells(30, Columns.Count).End(1).Column
For i = 76 To 142 Step 5
For a = 2 To 26
If Cells(i + 1, a) <> "0" Then
If Cells(i, a) > Range("AK7").Value Then
son = 30
If Cells(46, sut) <> "" Then
Cells(son, sut) = Cells(i + 1, sut + 5)
sut = sut + 5
Else
Cells(46, sut).End(3)(2, 1) = Cells(i + 1, sut + 5)
son = son + 1
End If
End If
End If
Next a
Next i
i = Empty: son = Empty: a = Empty
End Sub

Sayın Murat beyin hazırladığı makroyu yapıştırıyorum makromuz iyi durumda fakat makronun taradığı alanda bir sorun var
dosyada ekleyeceğim karne sayfasında olan bir hücreye değer yazıyorum ve o değerle i satırındaki 76 dan başlıyor 2 sütundaki değerleri krtierle kıyaslıyor(AK7) kriterden küçükse o hücrenin altındaki hücreyi sırayla a17:ab46 arasına boşluk bırakmadan ve sıfır yazmadan devam edecek mümkünse de 30 satır aşağı inildikten sonra 4 sütun öteden başlasın da yazılar birbirine girmesin.

Murat beye soracak yüzüm kalmadı artık ve daha önce açtığım konuyu kitledim(sanırım biz silemiyoruz)forumda kirlilik olmasın ..

ilginize teşekkür ederim..

 

[mehmethoca]

bu kod çalışınca k3 hücredeki formülü siliyor.. akıl sağlığım gidecek ..yardım ltf