sıfırdan farklı bir değerleri kopyalamak

[setuana]

arkadaşlar öncelikle herkese merhaba.
benim istediğim sıfırdan farklı bir değer girildiğinde o tabloyu komple diğer sayfaya kopyalasın.EKTEKİ DOSYADA AYRINTILAR YER ALIYOR.

şimdiden çok teşekkür ederim yardım eden arkadaşlara:yardim:



<<<<dosya ekleyemiyorum yardımcı olursanız sevinirim>>>>

 

[xxcell]

ekte dosya yok

 

[Levent Menteşoğlu]

Dosya eklemek için aşağıdaki linki inceleyin.

Sorunun devamında, ataç eklemek( Dosya eklemek).

 

[setuana]

arkada&#351;lar dosyay&#305; ilk a&#231;t&#305;&#287;&#305;m konuya ili&#351;tirdim.cevap yazarsan&#305;z sevinirim

 

[N.Ziya Hiçdurmaz]

yanıt

Sub aktar()
Set s1 = Sheets("sayfa1")
Set s2 = Sheets("RAPOR")
For Each bak1 In s1.Range("h3:h20")
If bak1 <> 0 Then
Range(bak1.Offset(0, -6), bak1.Offset(0, 1)).Copy
s = s + 1
s2.Range("c" & s + 3).PasteSpecial
End If
Next
Application.CutCopyMode = False
End Sub

 

[Seyit Tiken]

Alternatif :
Nisbetten kodlar biraz daha hızlandırılmış. Ekli dosyayı inceleyiniz.

Sub Düğme1_Tıklat()
[SAYFA1!B3:I21].Copy Destination:=[RAPOR!A6500].End(3).Offset(1)
For a = [RAPOR!G65000].End(3).Row To 1 Step -1
If Sheets("RAPOR").Cells(a, 7) = 0 Then Sheets("RAPOR").Cells(a, 7).EntireRow.Delete
Next
[RAPOR!A1].EntireRow.Insert
MsgBox "İşlem okey", vbInformation
End Sub

 

[setuana]

arkadaşlar bu bilgiler çok yararlı oldu.çok teşekkür ederim

 

[ayabenzer1]

arkada&#351;lar slm, bu olay&#305; daha basit yapabilirmiyiz.mesela benim istedi&#287;im a1 h&#252;cresindeki de&#287;er s&#305;f&#305;rdan farkl&#305; ise c1 e yazs&#305;n.