aktarma

[msanli]

Merhaba,
Çalışma kitabı içinde bulunan sayfaların birini veri girişi olarak kullanıyorum.
Bu sayfa a17'den O66ya kadar gidiyor.

Yapmak istediğim b17-k66 arasındaki verileri başka bir sayfadaki b15-j64 arasına aktarması. Bu işlemi yaparken de veri sayfasındaki "c" ve "d" hücresindeki verileri diğer sayfada "c" hücresinde birleştirmesi.

bunun için nasıl kod yazabiliriz?

 

[Orion1]

Belirlenen aralaıktaki Sayfa1 deki verileri sayfa2'ye aktarır

Sub aktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Application.ScreenUpdating = False
s2.Range("B15:J64").ClearContents
s2.Range("B15:B64").Value = s1.Range("B17:B66").Value
For i = 17 To 66
    s2.Cells(i - 2, "C").Value = s1.Cells(i, "C").Value [B][COLOR="Red"]& "-" &[/COLOR][/B] s1.Cells(i, "D").Value
Next i
s2.Range("D15:J64").Value = s1.Range("E17:K66").Value
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır."
End Sub

 

[msanli]

müthişsiniz...

bu işlem işimi ne kadar kolaylaştırdı bilemezsiniz. Bu kodları diğer işlemlerde de kullanmaya çalışacağım. takıldığım yerde yine yardımınızı isteyebilirmiyim?

 

[msanli]

şimdi farkına vardım. birleştirilen hücreleri "-" işareti ile ayıra bilirmiyiz?

 

[Orion1]

şimdi farkına vardım. birleştirilen hücreleri "-" işareti ile ayıra bilirmiyiz?

İstediğniz şekilde rvize ettim.Önceki mesajıömdan indirebilirsiniz.

 

[msanli]

sayın evren gizlen, yardımınız için teşekkür ederim...

 

[Orion1]

sayın evren gizlen, yardımınız için teşekkür ederim...

Rica ederim.
iyi çalışmalar.

 

[msanli]

sayın evren gizlen,

verdiğiniz kodları kullanarak, 2 sayfaya veri aktarmak istediğimde hata yapıyor. c73-122 arasında işlem yapması gerekirken c65-114 arasına veri aktarıyor.


Sub aktar()
Set s1 = Sheets("VERI GIRISI")
Set s2 = Sheets("TALLY SHEET")
Application.ScreenUpdating = False
s2.Range("B15:J64").ClearContents
s2.Range("B15:B64").Value = s1.Range("B17:B66").Value
For i = 17 To 66
s2.Cells(i - 2, "C").Value = s1.Cells(i, "C").Value & "-" & s1.Cells(i, "D").Value
Next i
s2.Range("D15:J64").Value = s1.Range("E17:K66").Value
Application.ScreenUpdating = True
s2.Range("B73:J122").ClearContents
s2.Range("B73:B122").Value = s1.Range("B67:B116").Value
For i = 67 To 116
s2.Cells(i - 2, "C").Value = s1.Cells(i, "C").Value & "-" & s1.Cells[/COLOR](i, "D").Value
Next i
s2.Range("D73:J122").Value = s1.Range("E67:K116").Value
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır."
End Sub