satır ekleme

[yusufcam]

bir excel çalışmasında A sütununda bulunan hücrelerdeki değer kadar altına satır ekleme gibi bir formül olabilir mi mesela A 1 hücre değeri 3 olsun bunun altına boş 2 satır eklene bilir mi çalışma ekte bu kitaba uygulanacak. teşekkürler iyi çalışmalar

 

[bkts34]

Merhaba,

Dosyanızı ben indiremiyorum inceleyemedim o yüzden ama aşağıdaki kodu bir modüle yazıp denermisiniz ? İsterseniz sayfa adını da düzenleyin satır ekleyeceğiniz sayfa adına göre.

Sub ekle()
For i = ActiveSheet.Range("a65536").End(3).Row To 1 Step -1
c = Cells(i, 1).Value - 1
For x = 1 To c
If c > 0 Then
ActiveSheet.Rows(i + 1).Insert Shift:=xlDown
End If
Next x
Next i
End Sub

 

[yusufcam]

teşekkür ederim dosyayı yeniden atıyım kodu modüle yerleştiremedim.

 

[yusufcam]

dosyayı degiştirdim

 

[bkts34]

Dosyanızı aşağıdaki linkteki siteye yükleyip linkini buraya atarsanız indirebilirim ancak,

http://s2.dosya.tc/

 

[yusufcam]

dediğiniz yere attım çalışma1

 

[yusufcam]

http://s2.dosya.tc/server2/7xw17e/calisma1.xlsx.html

 

[yusufcam]

dediğiniz kodları çalışma kitabıma uyguladım çalıştırdım işlem bitince Run-time error '13' diye uyarı geliyor Debug deyince modülde yazdığım komuta
c=Cells (i, 1).Value-1 komutu na yönlendiriyorum.
bu benim yapmak istediğim işlemi yapıyor. Teşekkür ederim.
dediğiniz linki de atmıştım

 

[YUSUF44]

Aşağıdaki kodları deneyiniz. Kodlar A sütunundaki değer sayıysa o sayı kadar altına satır ekler:

Sub ekle()
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If IsNumeric(Cells(i, "A")) = True Then
        c = Cells(i, 1).Value
        Rows(i + 1 & ":" & i + c).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    End If
Next i
End Sub

 

[yusufcam]

Kodlar A sütunundaki değer sayıysa o sayı kadar altına satır ekliyor.
Peki aynısını osayı kadar eklenen satıra aynı bilgileri kopyalayarak ekleye bilir mi ilginiz için teşekkür ederim. cevabınızı mearakla bekliyorum.

 

[bkts34]

Merhaba,
Eğer hala işinize yarayacaksa benim gönderdiğim kodda For i = ActiveSheet.Range("a65536").End(3).Row To 1 Step -1

kırmızı renkte 1 olan yeri 2 yapmanız yeterli.

 

[YUSUF44]

Aşağıdaki gibi deneyiniz:

Sub ekle()
For i = Cells(Rows.Count, "A").End(3).Row To 1 Step -1
    If IsNumeric(Cells(i, "A")) = True Then
        c = Cells(i, 1).Value
        Rows(i + 1 & ":" & i + c).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Rows(i).Copy Rows(i + 1 & ":" & i + c)
    End If
Next i
End Sub

 

[yusufcam]

çok teşekkür ederim.

 

[yusufcam]

gönderdiğiniz kodu uyguladım oldu ancak bir fazla oluyor A1 değer 4 se A1 dahil 4 satır ekleyip kopyalacak yani sizin gönderdiğiniz kendisi dahil 4 se 5 olarak yapıyor

 

[YUSUF44]

O noktayı gözden kaçırmışım, aşağıdaki gibi kullanın. Kod A sütununda 2. satırdan itibaren, değer sayıysa ve 1'den büyükse sayının bir eksiği kadar kopyalama yapar:

Sub ekle()
For i = Cells(Rows.Count, "A").End(3).Row To 2 Step -1
    If IsNumeric(Cells(i, "A")) = True Then
        If Cells(i, "A") > 1 Then
            c = Cells(i, 1).Value - 1
            Rows(i + 1 & ":" & i + c).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            Rows(i).Copy Rows(i + 1 & ":" & i + c)
        End If
    End If
Next i
End Sub

 

[yusufcam]

teşekkürler