Dolu satırları seçerek başka bir yere kopyalama.

[tb]

Merhaba, sorum aynı sayfada yanlarında tutar olan satırları başka bir hücreden başlayarak alta doğru yazdırmak için nasıl bir kod yazılabilir. Örnek dosya ekte. İlginiz için teşekkür ederim.

 

[nsertoglu]

Aşağıdaki kodu deneyiniz:

Sub tutar_byk0_aktar()

'parametreler
syf = "sayfa1"
rw1 = 3 ' ilk fiyat bulunabilecek satır
rw2 = Cells(Rows.Count, "a").End(xlUp).Row ' son fiyat bulunabilecek satır
TL_kolon = "C"

' eski kayıtlar silinsin
Range("E17:G" & Rows.Count).ClearContents
' eski kayıtlar silindi

For r = rw1 To rw2
If Cells(r, TL_kolon) > 0 Then
alnTL = Cells(r, TL_kolon)
alnTR = Cells(r, "A")
alnAD = Cells(r, "B")
yzRw = Cells(Rows.Count, "e").End(xlUp).Row + 1
Cells(yzRw, "e") = alnTR
Cells(yzRw, "f") = alnAD
Cells(yzRw, "g") = alnTL
End If
Next r

MsgBox "Sıfırdan Büyük Tutarlı Sipariş bilgileri Taşındı "

End Sub

 

[antonio]

Merhaba, sorum aynı sayfada yanlarında tutar olan satırları başka bir hücreden başlayarak alta doğru yazdırmak için nasıl bir kod yazılabilir. Örnek dosya ekte. İlginiz için teşekkür ederim.

Sub aktar()
Dim sh As Worksheet, ss As Integer, j As Integer
Set sh = Worksheets("Sayfa1")
ss = sh.Range("C" & Rows.Count).End(3).Row
sh.Range("E17:G" & Rows.Count).ClearContents
sh.Range("H16").Select
j = 3
k = 17
Do While j <= ss
If sh.Range("C" & j) = "" Then j = j + 1
Cells(k, "E").Value = Cells(j, "A").Value
Cells(k, "F").Value = Cells(j, "B").Value
Cells(k, "G").Value = Cells(j, "C").Value
j = j + 1
k = k + 1
Loop
End Sub

Dosyanız ektedir.

 

[tb]

İlginiz için çok teşekkür ederim. Yazdığınız kodlarla sorun çözüldü.