C Sütunundaki Değer Kadar Satır Sayısını Çoğaltmak

[ottoman71]

Arkadaşlar ekteki dosyada detaylı olarak anlattım.
Yardımlarınız için teşekkür ederim.

 

[Husgvarna]

Aşağıdaki kodu deneyin.

  Application.ScreenUpdating = False
For a = Cells(65000, 1).End(xlUp).Row To 2 Step -1
b = Cells(a, 3)
If b > 1 Then
Rows(a + 1 & ":" & a + b - 1).Insert Shift:=xlDown
Cells(a, 3) = 1
Rows(a + 1 & ":" & a + b - 1).Value = Rows(a & ":" & a).Value
End If
 Next
 Application.ScreenUpdating = True

 

[uzmanamele]

merhaba

bu kod işinizi görür mü?

Sub SatirAc()
Application.ScreenUpdating = False
ss = Range("a65536").End(3).Row
For i = ss To 2 Step -1
adet = Cells(i, 3).Value
For j = 1 To adet - 1
Cells(i + 1, 3).EntireRow.Insert
Next
Range("a" & i & ":" & "s" & i).Copy Range("a" & i + 1 & ":" & "s" & i + adet - 1)
Next
Application.ScreenUpdating = True
    yss = Range("a65536").End(3).Row
    Range("c2:c" & yss) = 1
    MsgBox "bittim"
End Sub

 

[ottoman71]

Aşağıdaki kodu deneyin.

Husgvarna hocam teşekkür ederim. Kod işimi gördü.
İyi çalışmalar.

 

[ottoman71]

merhaba

Hocam teşekkür ederim. Sizin verdiğiniz kod da işimi görüyor.
İyi çalışmalar.