aynı bilgilerle istenilen satır kadar satır doldurma

[muratcan302]

merhaba arkadaşlar excel de yeniyim ve vba konusunda çoğu şeyi bu forumdan öğrendim fakat takıldığım bir nokta oldu. şimdi a2 b2 c2 d2 e2 gibi 5 sütünumuz olsun ben vba dan bu 5 satıra ait bilgileri girecem sonra belirlediğim sayıya kadar bu satırları kopyalacak. örneğin a2 olanı a55 e kadar (buradaki 55 belirlenen sayı.) bunu nasıl yapabilirim. yardımcı olursanız sevinirim. iyi günler.

 

[YUSUF44]

Anladığım kadarıyla aşağıdaki kodları bir modüle ekleyip deneyiniz. Kodlar önce A3'ten aşağı doğru dolu hücrelerin içeriğini temizler, aynısını E sütununa kadar yapar. sonra size sırasıyla her sütun için hangi satıra kadar kopyalama yapılacağını sorar. Son olarak A2'yi kopyalayıp belirlediğiniz son satıra kadar yapıştırır. Aynısınız diğer sütunlara da yapar:

Sub kopya()
Application.ScreenUpdating = False
Range("A3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
Range("B3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
Range("c3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
Range("d3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
a = InputBox("A sütununda kopyalama yapılacak son son satır numarasını giriniz")
b = InputBox("B sütununda kopyalama yapılacak son son satır numarasını giriniz")
c = InputBox("C sütununda kopyalama yapılacak son son satır numarasını giriniz")
d = InputBox("D sütununda kopyalama yapılacak son son satır numarasını giriniz")
e = InputBox("E sütununda kopyalama yapılacak son son satır numarasını giriniz")
[a2].Copy
Range("A3:A" & a).Select
ActiveSheet.Paste
[b2].Copy
Range("B3:B" & b).Select
ActiveSheet.Paste
[c2].Copy
Range("c3:c" & c).Select
ActiveSheet.Paste
[d2].Copy
Range("d3:d" & d).Select
ActiveSheet.Paste
[e2].Copy
Range("e3:e" & e).Select
ActiveSheet.Paste
Application.CutCopyMode = False
[a1].Select
tamam = MsgBox("İşlem tamamlanmıştır")
End Sub

 

[muratcan302]

ilgi ve alakanız için teşekkür ederim.

 

[YUSUF44]

Kolay gelsin.