Bir sayfadaki bazı verilerin başka bir sayfaya aktarılması

[mustafa]

Elimde iki sayfadan oluşan bir excel belgesi var. Sorunum şu; Sayfa1 deki bazı hücrelerin sayfa2 deki aynı yerlere makro ile aktarılmasını istiyorum. Ekteki dosyada bir örneği mevcut. Resimle de anlatmaya çalıştım. Umarım başarılı olmuşumdur. Yardımcı olacak kardeşlere şimdiden teşekkür ediyorum.

 

[cems]

Bundan sonra bir işlem adımı yoksa ilk sayfayı kopyalayarak ikinci sayfayı yaratmak ve sonuç sütunlarını gizlemek en kolay yol gibi görünüyor.

Ya da aktarılan hücre ile aktarılacak hücre arasına "+" ile tek bir hücreye köprü atarak sonra da kenarından tutup sağa ve aşağı çekerek de olabilir.Bu şekilde aktarılacak veri değiştiğinde aktarılmış veri de otomatik değişir.

Makro ya da formüle gerek olmadan bunlar çözer.

 

[mustafa]

Aslında deneme dosyası ekledim ama demek istediğim şeyi onunla anlatamayacağım. Şimdi esas dosyamı ekliyorum.

Okulumda Ekders Çizelgesi olarak kullandığım dosyada bazen elle veri girmek gerekiyor, böyle olunca da formüller siliniyor. Bunun üzerine çözüm olması açısından Çizelgem adlı formüllü sayfayı gizledim ve makro ile verileri Çizelge adlı sayfaya aktarıyorum. Eğer elle veri girmek gerekiyorsa, formüller silinmemiş oluyor. Fakat elle veri girince bu kez toplam sütunları değişmiyor. Ben istiyorum ki, Çizelgem adllı sayfadan Toplam sütunları dışındaki sütunlar kopyalansın ve Çizelge adlı sayfaya aktarılsın.

 

[mustafa]

Galiba excel ustaları konuyu görmedi, yoksa isteğim çözülemeyecek bir şey olmaması gerek.

 

[mustafa]

Bu konu hakkında hiçbir fikri olan yok mu?

 

[Husgvarna]

Çizelgem adllı sayfadan Toplam sütunları dışındaki sütunlar kopyalansın ve Çizelge adlı sayfaya aktarılsın.

Merhaba.
"Çizelge" adlı sayfada oluşturacağınız butona aşağıdaki kodları ekleyip deneyin

Private Sub CommandButton1_Click()
b = 0
For a = 1 To 5
Sheets("Çizelgem").Range(Sheets("Çizelgem").Cells(9, 6 + c), Sheets("Çizelgem").Cells(53, 13 + b)).Copy
Sheets("Çizelge").Range(Cells(9, 6 + c), Cells(53, 13 + b)).PasteSpecial [COLOR="Red"]Paste:=xlPasteValues[/COLOR], Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
b = b + 9: c = c + 9
If a = 4 Then b = b + 1
Next
Application.CutCopyMode = False
End Sub

Eğer değerler değilde formüller kopyalanmasını isterseniz kırmızı bölümün yerine

 Paste:=xlPasteFormulas

yazınız.

Dosya aşağıdaki linkte.

http://www.dosya.tc/server12/VPqwvG/Ekders.zip.html

 

[mustafa]

Hocam eline sağlık, fakat şöyle bir eksiği var, kopyalanacak sütunların C'den başlaması gerekiyor. Yani Çizelgem adlı sayfadaki şu sütunların kopyalanmasını istiyorum.

C9:M51, O9:V51, X9:AE51, AG9:AN51, AP9:AX51

Bu sütunlar Çizelge adlı sayfada aynı yere yapışsın. Bir de Çizelge adlı sayfada N9:N51, W9:W51, AF9:AF51, AO9:AO51, AY9:AZ51 hücrelerdeki verilerin silinmemesi için ne yapabilirim? Bunun yerine sadece A, W, AF, AO, AY ve AZ sütunları da olabilir.

 

[Husgvarna]

Hocam eline sağlık, fakat şöyle bir eksiği var, kopyalanacak sütunların C'den başlaması gerekiyor. Yani Çizelgem adlı sayfadaki şu sütunların kopyalanmasını istiyorum.

C9:M51, O9:V51, X9:AE51, AG9:AN51, AP9:AX51

Bu sütunlar Çizelge adlı sayfada aynı yere yapışsın. Bir de Çizelge adlı sayfada N9:N51, W9:W51, AF9:AF51, AO9:AO51, AY9:AZ51 hücrelerdeki verilerin silinmemesi için ne yapabilirim? Bunun yerine sadece A, W, AF, AO, AY ve AZ sütunları da olabilir.

Merhaba.
Kopyalama kodlarını şöyle değiştirin.

 Private Sub CommandButton1_Click()
Dim kopyala() As Variant
For a = 0 To 4
kopyala = Array("C9:M51", "O9:V51", "X9:AE51", "AG9:AN51", "AP9:AX51")
Sheets("Çizelgem").Range(kopyala(a)).Copy
Sheets("Çizelge").Range(kopyala(a)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next
Application.CutCopyMode = False
End Sub

Aşağıdaki kodu "Çizelge" adlı sayfanın kod sayfasına ekleyerek ilgili hücrelere
girişi engelleyip değiştirilmemesini sağlayabilirsiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("N9:N51,W9:W51,AF9:AF51,AO9:AO51,AY9:AZ51")) Is Nothing Then [a1].Select
End Sub

http://www.dosya.tc/server12/gsMshh/Ekders2.zip.html

 

[mustafa]

Merhaba.
Aşağıdaki kodu "Çizelge" adlı sayfanın kod sayfasına ekleyerek ilgili hücrelere
girişi engelleyip değiştirilmemesini sağlayabilirsiniz.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("N9:N51,W9:W51,AF9:AF51,AO9:AO51,AY9:AZ51")) Is Nothing Then [a1].Select
End Sub

Hocam çok güzel oldu ama bu kodu yapıştırınca, gizli satırları göstermesi için yaptığım makro çalışmaz oldu. Buna bir çözüm var mı?

 

[Husgvarna]

gizli satırları göstermesi için yaptığım makro çalışmaz oldu. Buna bir çözüm var mı?

Makronuzu aşağıdaki gibi değiştirirseniz çalışır.

Sub Göster()
Application.ScreenUpdating = False
Cells.EntireRow.Hidden = False
Application.ScreenUpdating = True
Range("A1").Select
End Sub

 

[mustafa]

Allah razı olsun, çok memnun oldum. İyi çalışmalar dilerim.