Satırları alt alta kopyalama

[Tores333]

Merhaba,

Excel de satırları alt alta kopyalamak istiyorum makro ile yapabilir miyiz?

Simetrik olarak hücreleri yeni sekmede kopyalamak istedim ama sıralı olmasına ragmen aralarda satır atladı.

Kopyalama aynı yada yeni sekmede olabilir.

Örnek;

Satır1: A1 B1 C1 D1 ...
Satır2: A2 B2 C2 D2 ...

İstediğim;

Satır1: A1 B1 C1 D1 ....
Satır2: A1 B1 C1 D1 ....
Satır3: A2 B2 C2 D2 ....
Satır4: A2 B2 C2 D2 ....
Şeklinde devam ediyor


Teşekkürler.

 

[vardar07]

Elle hazırlanmış bir örnek dosya ekleyin olup olmayacağına bir bakalım. Dosya eklemek için imza bölümünü okuyun.

 

[Tores333]

merhaba,

link eklenmiştir.

https://upterabit.com/2AJc/%C3%B6rnek_sat%C4%B1r_kopyalama.xlsx

Teşekkürler

 

[Tores333]

Günceldir.

 

[Ömer BARAN]

Merhaba.

Verdiğiniz örnek belge erişim adresi, Google Chrome tarafından "güvenlik sorunu" uyarısı veriyor ve örnek belgenize ulaşılamıyor.
İsterseniz örnek belgenizi, cevabımın altındaki İMZA bölümünde balirttiğim sitelerden birine yükleyin.
.

 

[Tores333]

Merhaba.

Verdiğiniz örnek belge erişim adresi, Google Chrome tarafından "güvenlik sorunu" uyarısı veriyor ve örnek belgenize ulaşılamıyor.
İsterseniz örnek belgenizi, cevabımın altındaki İMZA bölümünde balirttiğim sitelerden birine yükleyin.
.

merhaba,

Dosya tc üzerinden de ekledim.

http://s9.dosya.tc/server2/3wmxlq/ornek_satir_kopyalama.xlsx.html

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'u boş bir Modül'e ekleyin ve çalıştırın.
.

[FONT="Arial Narrow"][B]Sub IKILEME()[/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For s = Sheets.Count To 1 Step -1
    Application.DisplayAlerts = False
        If Sheets(s).Name = "yeni" Then Sheets(s).Delete
    Application.DisplayAlerts = True
Next
Sheets("Sheet1").Activate
Sheets("Sheet1").Copy After:=ActiveSheet
ActiveSheet.Name = "yeni"
Set y = Sheets("yeni")
sonsat = y.[A65536].End(3).Row: sonsut = y.[IV1].End(1).Column

For satır = sonsat To 1 Step -1
    y.Range(y.Cells(satır, 1), y.Cells(satır, sonsut)).Copy
    y.Cells(satır, 1).Insert Shift:=xlDown
Next
    Application.CutCopyMode = False
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem Tamamlandı..", vbInformation, " ...:: Tores333 ::... "
[B]End Sub[/B][/FONT]