Veri Aktar

[raguzel]

Değerli arkadaşlar;
Ek dosyada bir sayfadan diğer bir sayfaya veri aktarma örneği vardır. Yanlız bu kodlar sadece belirli hücreleri aktarıyor. Alt satırlara doğru liste uzadığında da yazdırılsın istiyorum ve ayrıca tablonun üstündeki tarih hücresi sıralı bir şekilde diğer sayfaya aktarılabilirmi?
Teşekkürler.

 

[Ömer]

Merhaba,

Aşağı satırdan kastınız nedir? Örnek dosyanızı formatın nasıl istiyorsanız o şekilde hazırlayıp üzerinde manuel değerler girerek açıklayınız..

.

 

[raguzel]

Dosya değişti.

Merhaba,

Aşağı satırdan kastınız nedir? Örnek dosyanızı formatın nasıl istiyorsanız o şekilde hazırlayıp üzerinde manuel değerler girerek açıklayınız..

.

Ekli dosyayı değiştirdim. İlginize teşekkürler...

 

[Ömer]

Ekli dosyayı değiştirdim. İlginize teşekkürler...

Sub Deneme()
Set S1 = Sheets("Sayfa2")
S1.Range("B5:K65536").ClearContents
    son1 = [A65536].End(3).Row
    Range("A6:I" & son1).Copy S1.Range("B5")
    son = S1.[B65536].End(3).Row
    Range("B3").Copy S1.Range("K5:K" & son)
End Sub

.

 

[raguzel]

Sorun var..

Sub Deneme()
Set S1 = Sheets("Sayfa2")
S1.Range("B5:K65536").ClearContents
    son1 = [A65536].End(3).Row
    Range("A6:I" & son1).Copy S1.Range("B5")
    son = S1.[B65536].End(3).Row
    Range("B3").Copy S1.Range("K5:K" & son)
End Sub

.

Çok teşekkür ederim... Elinize, emeğinize, yüreğinize sağlık..

Kodlar çok güzel ancak sorun, her defasında hedef tabloyu siliyor. Benim istediğim hedef data'yı silmeden en alttaki boş satırı bulsun ve buradan yazmaya devam etsin, aktarılan sayfayı silmesine gerek yok...

 

[Ömer]

Aktarılan sayfadaki bilgiler silinmeyecekse kırmızı olan bölgedeki kodları silersiniz..

Sub Deneme()
Set S1 = Sheets("Sayfa2")
    son = S1.[B65536].End(3).Row + 1
    son1 = [A65536].End(3).Row
    Range("A6:I" & son1).Copy S1.Range("B" & son)
    son = S1.[B65536].End(3).Row + 1
    Range("B3").Copy S1.Range("K5:K" & son - 1)
[COLOR=red]Range("A6:I65536").ClearContents
[/COLOR]End Sub

 

[raguzel]

İlginize teşekkürler...

Sub Deneme()
Set S1 = Sheets("Sayfa2")
S1.Range("B5:K65536").ClearContents
    son1 = [A65536].End(3).Row
    Range("A6:I" & son1).Copy S1.Range("B5")
    son = S1.[B65536].End(3).Row
    Range("B3").Copy S1.Range("K5:K" & son)
End Sub

.

Aktarılan sayfadaki bilgiler silinmeyecekse kırmızı olan bölgedeki kodları silersiniz..

Sub Deneme()
Set S1 = Sheets("Sayfa2")
    son = S1.[B65536].End(3).Row + 1
    son1 = [A65536].End(3).Row
    Range("A6:I" & son1).Copy S1.Range("B" & son)
    son = S1.[B65536].End(3).Row + 1
    Range("B3").Copy S1.Range("K5:K" & son - 1)
[COLOR=red]Range("A6:I65536").ClearContents[/COLOR]
End Sub

Yanlız bu seferki sorun, aktarılan sayfadaki tabloyu biçimleriyle birlikte hedef tabloya aktarıyor. Sadece dolu hücreleri aktarsa... Mümkünmü?

 

[Ömer]

Yanlız bu seferki sorun, aktarılan sayfadaki tabloyu biçimleriyle birlikte hedef tabloya aktarıyor. Sadece dolu hücreleri aktarsa... Mümkünmü?

Sub Deneme()
Application.ScreenUpdating = False
Set S1 = Sheets("Sayfa2")
    son = S1.[B65536].End(3).Row + 1
    son1 = [A65536].End(3).Row
If son1 = 5 Then Exit Sub
    Range("A6:I" & son1).Copy
    S1.Range("B" & son).PasteSpecial xlPasteValues
    son = S1.[B65536].End(3).Row + 1
    Range("B3").Copy
    S1.Range("K5:K" & son - 1).PasteSpecial xlPasteValues
[COLOR=red]Range("A6:I65536").ClearContents[/COLOR]
Application.ScreenUpdating = True
End Sub

.