Bir alttaki bir hücreye bir sayı yazıldığında; bir üst satırdaki bilgilerin bir alt satıra aktarılması

[Bayram Paşa]

[TR][TD]

[/TD][/TR]
[TR][TD]
Personel adında bir excel dosyam var. Bu dosyanın sayfa1 sayfasında mesela A22 hücresine sayı olarak 19 yazdığımda bir üst satırda bulunan BA21 - BU21 hücreleri arasındaki tüm bilgilerin (hücrelerin) bir alt satıra yani BA22 _ BU22 arasındaki hücrelere aktarılmasını VBA kodu ile yapabilir miyiz?
Şimdiden teşekkür ediyorum.
Hayırlı Bayramlar diliyorum.
[/TD][/TR]

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[Bayram Paşa]

Üstadım, çok teşekkür ederim. Hayırlı Bayramlar

 

[Bayram Paşa]

Burada sayıları yazıp bir alt hücreye geçince üstteki o bilgiler gayet güzle bir şekilde alta aktarılıyor.
Fakat bu sayıları mesela 2 den 40 kadar başka bir yerden kopyalayıp buraya A2 hücresinden itibaren yapıştırdığımızda bu bilgiler gelmiyor. Bu bilgiler Sadece bir satır olarak aşağıya aktarılıyor.
A5 hücresinden itibaren 2 den 40 kadar olan sayıları başka bir yerden kopyalayıp yapıştırdığımızda Bu şekilde bu bilgilerin 5. satırdan 43. satıra kadar gelmesi için ne yapabiliriz.

 

[Tevfik_Kursun]

Merhaba Arkadaşım,
İstediğiniz bu mudur?
İyi çalışmalar, iyi bayramlar

 

[Bayram Paşa]

Tevfik bey, ilginiz için teşekkür ederim.
Bu şekilde değil. Yani buton kullanmadan Kopyalanan sayıları yapıştır dediğimiz anda bilgilerin gelmesi gerekiyor..

 

[Bayram Paşa]

Tevfik bey hem de aynı sayfada olması lazım. Siz başka bir sayfadan verileri kopyalamışsınız

 

[Tevfik_Kursun]

Merhaba Arkadaşım,
Nasıl olmasını istiyorsanız ona uygun bir örnek koyun, kolaylıkla uyarlanır diye düşünüyorum.
İyi çalışmalar

 

[Bayram Paşa]

Göndermiş olduğum Personel adındaki excel dosyasının sayfa1 sayfasında mesela A5 - C18 hücre aralığını seçip kopyala diyeceğiz. Sonra imleci A5 hücresine getirip YAPIŞTIR dediğimizde BA4 - BU4 arasındaki bilgiler BA5 - BU18 aralığına otomatik olarak gelecek.

 

[YUSUF44]

Hayırlı bayramlar.

Aşağıdaki kodları sayfanın kod bölümüne (sayfa adına sağ tıklayıp kod görüntüle deyince açılan sayfaya) yapıştırıp deneyin:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A5:A1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
    bas = Selection.Row
    bit = Selection.Rows.Count + bas - 1
    Range("BA" & bas - 1 & ":BU" & bas - 1).Copy Range("BA" & bas & ":BU" & bit)
Else
    Range("BA" & Target.Row - 1 & ":BU" & Target.Row - 1).Copy Range("BA" & Target.Row)
End If
End Sub

 

[YUSUF44]

Aşağıdaki kodlar da aynı işi görüyor:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A5:A1000]) Is Nothing Then Exit Sub
If Selection.Count > 1 Then
    Range("BA" & Target.Row - 1 & ":BU" & Target.Row - 1).Copy Selection.Offset(0, 52)
Else
    Range("BA" & Target.Row - 1 & ":BU" & Target.Row - 1).Copy Target.Offset(0, 52)
End If
End Sub

 

[YUSUF44]

Aşağıdaki kodların aynı işi görmeyeceğiniz düşünüyordum ama ilginç bir şekilde istediğinizi yapıyor:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A5:A1000]) Is Nothing Then Exit Sub
Range("BA" & Target.Row - 1 & ":BU" & Target.Row - 1).Copy Target.Offset(0, 52)
End Sub

 

[Bayram Paşa]

Evet bu son kodlar tam istediğim gibi .
Çok teşekkür ederim.
Emeğinize sağlık.
Allaha emanet olun.