Tüm satırları yineleme veya çoğaltma

[SLaYeR983]

Excel sayfasındaki tüm satırları alta doğru çoğaltmak istiyorum ama bir türlü beceremedim. 20bin satırdan fazla olduğu için de tek tek elle girmek çok uğraştırır.

Ahmet
Mehmet
İsmet

gibi bir sayfayı

Ahmet
Ahmet
Mehmet
Mehmet
İsmet
İsmet

şeklinde yazdırmak istiyorum. yardım lütfen.

 

[Emir Hüseyin Çoban]

. . .

İsimlerin A1' den başladığını varsayarak. Aşağıdaki kodları deneyiniz.

Sub KOD()
    Application.ScreenUpdating = False
    
    For i = [A65536].End(3).Row To 1 Step -1
        If Cells(i, "A") <> "" Then
            Rows(i).Insert Shift:=xlDown
            Cells(i, "A") = Cells(i + 1, "A")
        End If
    Next i
    
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[Murat OSMA]

Alternatif olarak bu kodlar da kullanılabilir;

[FONT="Trebuchet MS"]Sub Emre()
    Application.ScreenUpdating = False: [COLOR="red"]i%[/COLOR] = 1
    [COLOR="red"]While [/COLOR]Cells(i, 1) [COLOR="red"]<> ""[/COLOR]
        Cells(i + 1, 1).Insert
        Cells(i + 1, 1).[COLOR="Red"]FillDown[/COLOR]
        [COLOR="Red"]i = i + 2[/COLOR]
    [COLOR="red"]Wend[/COLOR]
    Application.ScreenUpdating = True
End Sub[/FONT]

 

[SLaYeR983]

Teşekkür ederim güzel oldu fakat bir ayrıntı kaldı, satırlar arasında boşluklar var onlarında çifter çifter kopyalanmasını istiyorum yardımcı olursan sevinirim.

Ahmet

mehmet


Ahmet
Ahmet


Mehmet
Mehmet gibi

 

[Emir Hüseyin Çoban]

Teşekkür ederim güzel oldu fakat bir ayrıntı kaldı, satırlar arasında boşluklar var onlarında çifter çifter kopyalanmasını istiyorum yardımcı olursan sevinirim.

Ahmet

mehmet


Ahmet
Ahmet


Mehmet
Mehmet gibi

. . .

If Cells(i, "A") <> "" Then ve End if ile başlayan satırları iptal edin.

. . .

 

[SLaYeR983]

tekrar yazsan, kusura bakma pek anlamam da

 

[Emir Hüseyin Çoban]

. . .

Konuya verdiğim son destekdir.

Sub KOD()
    Application.ScreenUpdating = False
    
    For i = [A65536].End(3).Row To 1 Step -1
            Rows(i).Insert Shift:=xlDown
            Cells(i, "A") = Cells(i + 1, "A")
    Next i
    
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[SLaYeR983]

Eyvallah artık her şey istediğim gibi oldu, hepinizden Allah razı olsun... iyi çalışmalar...

 

[zencmore]

. . .

İsimlerin A1' den başladığını varsayarak. Aşağıdaki kodları deneyiniz.

Sub KOD()
    Application.ScreenUpdating = False
   
    For i = [A65536].End(3).Row To 1 Step -1
        If Cells(i, "A") <> "" Then
            Rows(i).Insert Shift:=xlDown
            Cells(i, "A") = Cells(i + 1, "A")
        End If
    Next i
   
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

merhaba, bu macroyu b ve c stunlarına da aynı anda eklemek için ne yapmak lazım.

a, b, c stunları aynı anda çoklasın istiyorum.