Dolu satırlardan mükerrer satır olusturma

[nane]

Merhabalar,
Öncelikle;
Bizleri hayata getiren binbir emekle büyüten sonsuz sevgi, fedakarlık, şefkat ve iyilik abidesi tüm Annelerin Anneler gününü kutluyorum.
Yaba®

Excel sayfasında A sütünu ile CZ sütünları arasında 3600 yaklaşık satır girilmiş veri var.
Bunlar Tarih, Vade, Ft no, vs........tutar kdv gibi,

ben her bir satır için mükerrer satır oluşturmak iştiyorum.
Yani 1. Satırdaki tüm veriler 2. Satıra da kopyalansın
2.Satırdaki veriler bu durumda 3. Satıra kaydırılacak ve 4.Satır da aynı olacak.
Bu işlem 2.Sayfada yapılırsa daha iyi olur.
3600 satır olan veriler 3600+3600 =7200 satır olacak ve üstteki satır ile alttaki satır aynı olacak
her 1-2, 3-4, 5-6,........satırdaki veri anyı olacak şekilde sıranalmış olmalı
yardımlarınız için şimdiden teşekkürler...

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub cogalt()
son = Sheets("Sayfa1").Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
yeni = 1
For i = 1 To son
    Sheets("Sayfa1").Rows(i).Copy Sheets("Sayfa2").Cells(yeni, "A")
    Sheets("Sayfa1").Rows(i).Copy Sheets("Sayfa2").Cells(yeni + 1, "A")
    yeni = yeni + 2
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı"
End Sub

 

[fairfun]

sayfanızı başka bir sayfaya kopyalayın. Daha sonra en solda yeni bir sütun oluşturup, burada doldurma tutamacı yardımıyla 1,2,3,4 şeklinde tüm satırları numaralandırın. Daha sonra bu satır numaralarını da içerecek şekilde tüm verinizi seçin, ve en alt satıdaki verinin altına yapıştırın. Daha sonra sayfadaki tüm verileri, yeni eklediğiniz sütünuna göre küçükten büyüğe doğru sıralayın. Bu kadar.

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodları kullanabilirsiniz.

Aktif olan sayfadan Sayfa2 ye aktarır

Sub Test()
    Dim Sira As Long
    Dim Say As Long
    Rows(1).Copy Sayfa2.Rows(1)
    Say = Worksheets("Sayfa2").Cells(Rows.Count, "A").End(xlUp).Row + 1
    For Sira = 2 To Cells(Rows.Count, "A").End(xlUp).Row
        Rows(Sira).Copy Worksheets("Sayfa2").Rows(Say & ":" & Say + 1)
        Say = Say + 2
    Next
End Sub

 

[nane]

Merhabalar,
Yusuf44 bey in verdiği makroyu denedim oldu. teşekkür ediyorum.

Aslında yapmak istediğim gelir gider yani işletme defteri şeklinde olan kayıtları bilanço - yevmiye defteri usulüne getirmek.
Mesela bu aktarımda D sütünu Borçlu hesaplar, E sütünu Alacaklı hesaplar dan oluşuyor.
E sütünundaki Hesapları D sütünuna alsak tam olur.
Şöyle ki D1 Su gideri, E1 ise Bonus kredi kartı

Aktardığımızda ise
D1 Su gideri
D2 Bonus kredi kartı, asol yapmak istediğim budur.

E sütünu sininebilir veya öyle de kalabilir farketmez.

Şimdiden teşekkürler...

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub cogalt()
son = Sheets("Sayfa1").Cells(Rows.Count, "A").End(3).Row
Application.ScreenUpdating = False
yeni = 1
For i = 1 To son
    Sheets("Sayfa1").Rows(i).Copy Sheets("Sayfa2").Cells(yeni, "A")
    Sheets("Sayfa1").Rows(i).Copy Sheets("Sayfa2").Cells(yeni + 1, "A")
    Sheets("sayfa2").Cells(yeni + 1, "D") = Sheets("Sayfa2").Cells(yeni + 1, "E")
    yeni = yeni + 2
Next
Sheets("Sayfa2").Columns("E:E").Delete
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı"
End Sub

 

[nane]

Merhabalar,
Dalgalikur , gönderdiği makroyu da denedim çalışıyor. fakat uzun süre devam ediyor.
Sanırım benim kullandığım bilgisayar ile alakalı,
Teşekkürler...

 

[nane]

Merhabalar,
Fairfun belirtmiş olduğu sistem de mümkün fakat Sayfa1 de sürekli veri girişi olduğundan önceki aktarılanlar ve sonraki girişleri ayırt edip aktarmak uğraştırıcı olabilir.
Kendisine de teşekkürler...

 

[nane]

Yusuf44 bey,
Makroda A6 satırından başlasın bitiş için de A1200 satırda bitsin şeklinde yapabilir,

H6 hücrede borç yazıyor, H6 ya kopyalanda ise Alacak yazsın, yani kopyalanacak H satırı Borç ise kopyalanacak alt satıra Alacak yazsın, H6 da eğer Alacak yazıyor ise kopyalanacak alt satıra Borç yazsın

I6 dan başlamak üzere I sütününda tutarlar var, I6 dan kopyalnacak olan I7 sütüna değil de J7 ye aktarılsın.

Yardımlarınız için çok teşekkürler...

 

[YUSUF44]

Böyle olmaz o zaman, örnek dosya paylaşın lütfen. İlerde önceden belirlenmiş yeni istekleriniz de olacaksa şimdiden belirtin ki ona göre kod yazalım.