Makro Çalıştırarak veri kopyalama

[furens]

Arkadaşlar makro çalıştır ile denemeye çalştım ama yapıştırma işlemini hep aynı satıra yapıyor en son boş satıra yapamadım. açıklaması excell sayfasında var yardımlarınız için şimdiden tşk.

 

[furens]

Arkadaşlar yokmu bunun çözümü , forumda nice olmaz denilen işler yapılmış yardımlarınızı bekliyorum.

 

[devve]

Çok amatörce yaptım ama işinizi görüyor ve geliştirilebilir

Sub Makro1()
    'Dolu olan son satırı bulur
    sat = Cells(65536, "A").End(xlUp).Row
    Range("A" & sat & ":J" & sat).Select
    Selection.Copy
    Sheets("ARANANLAR").Select
    sat = Cells(65536, "A").End(xlUp).Row + 1
    Range("B" & sat).Select
    ActiveSheet.Paste
    Range("F" & sat & ":K" & sat).Select
    Selection.Copy
    Sheets("MÜD MAK").Select
    sat = Cells(65536, "A").End(xlUp).Row + 1
    Range("B" & sat).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Sheets("SORGU").Select
End Sub

 

[devve]

Otomatik sırano verilecekse eğer o da çözülebilir kolayca.

 

[furens]

yardımların için tşk.ancak olmamış yapıştırma işlemi hep aynı yere yapıyor benim dediğim gibi olmamış,ikinci satıra veri yazdığımda makroyu çalıştırınca önceki yapıştırılan yerin üstene yapıştırıyor. sıra noda konabilir. tşk.

 

[devve]

olmuş ama sen sırano yu boş bıraktığın için hep aynı satıra yapıştırıyor makro.
sat = Cells(65536, "A").End(xlUp).Row
bu kodda "A" yerine "B" yaparsan sırano girmeden çalıştırabilirsin yada sırano da gir.

edit: tam çözüm kodu aşağıdadır.

 

[devve]

Sırano yuda otomotik veren istediğiniz işleri eksiksiz yapan kodlar aşağıdadır. Kolay gelsin.

Sub SonSatiriKopyala()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'Dolu olan son satırı bulur
    sat = Cells(65536, "A").End(xlUp).Row
    Range("A" & sat & ":J" & sat).Select
    Selection.Copy
    Sheets("ARANANLAR").Select
    sat = Cells(65536, "A").End(xlUp).Row + 1
    sirano = Cells(sat - 1, "A").Value
    If Not IsNumeric(sirano) Then sirano = 0
    sirano = sirano + 1
    Cells(sat, "A").Value = sirano
    Range("B" & sat).Select
    ActiveSheet.Paste
    Range("F" & sat & ":K" & sat).Select
    Selection.Copy
    Sheets("MÜD MAK").Select
    sat = Cells(65536, "A").End(xlUp).Row + 1
    Range("B" & sat).Select
    ActiveSheet.Paste
    Cells(sat, "A").Value = sirano
    Application.CutCopyMode = False
    Sheets("SORGU").Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[devve]

Küçük bir yanlış anlamayıda düzelteyim. Bir önceki kod son satırdaki veriyi diğer sayfaların son satırına kopyalıyordu. Burada paylaştığım üzerine gelinen satırı diğer iki sayfanın son satırlarına kopyalıyor. Sanırım istediğin bu şekilde olmasıydı.

Sub SonSatiriKopyala()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    'üzerinde bulunulan satırı kopyalar
    sat = ActiveCell.Row
    Range("A" & sat & ":J" & sat).Select
    Selection.Copy
    Sheets("ARANANLAR").Select
    sat = Cells(65536, "A").End(xlUp).Row + 1
    sirano = Cells(sat - 1, "A").Value
    If Not IsNumeric(sirano) Then sirano = 0
    sirano = sirano + 1
    Cells(sat, "A").Value = sirano
    Range("B" & sat).Select
    ActiveSheet.Paste
    Range("F" & sat & ":K" & sat).Select
    Selection.Copy
    Sheets("MÜD MAK").Select
    sat = Cells(65536, "A").End(xlUp).Row + 1
    Range("B" & sat).Select
    ActiveSheet.Paste
    Cells(sat, "A").Value = sirano
    Application.CutCopyMode = False
    Sheets("SORGU").Select
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[furens]

abi çok sağol bu verdiğim excel sayfasında çalışıyor, asıl excell belgesine kopyaladığımda MÜD MAK sayfasında çizelgenin en altına yapıştırıyor. benim istediğim MÜD MAK sayfasında 54. satır ile 73. satır dahil ikisi arasında enson boş satıra yapıştırması, bu kısmınıda dediğim gibi düzeltebilirsen minnettar kalırım. tşk.

 

[furens]

Sheets("MÜD MAK").Select
sat = Cells(73, "B").End(xlUp).Row + 1
Range("B" & sat).Select
ActiveSheet.Paste
Cells(sat, "A").Value = sirano (bunuda sildim) deneme yanılma yöntemiyle oldu çok tşk.

 

[devve]

Burada paylaştığınız dosyada denedim "MÜD MAK" sayfasında 54-73. satırlar arasına yapıştırıyordu. Ama sizin kullandığınız dosyada görünmeyen karakterler olabilir bu yüzden listenin dışına yapıştırıyordur. Mesela boşluk karekteri varsa bu hücreyide dolu olarak algılar excel. Bence kullandığınız dosyayı temize çekin sorun kalmaz.
Ama zaten Cells(73,"A") yapmışsınız sadece 73.satıra kadar olan yere bakıyor, buda sorununuzu halletmiş. Benim yazdığım kodda cetvelin altında birşey olmaması gerekir, ama başka bilgilerde girlecekse cetvelin altına sizin kodunuz doğru çalışır.
Kolay gelsin.