Satır sonunda yazan sayıya göre o satırı kopyalama

[imsorrydude]

Arkadaşlar merhaba,

Benim talebim şu, ekteki dosyada satır sonunda yazan sayı kadar o satırı komple kopyalamasını istiyorum. Örneğin ekte ilk satırın sonunda yazan sayı 4 ise o satırın aynısından 4 tane oluştursun.

Yardımcı olacaklara şimdiden teşekkürler.

Saygılarımla.

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Duzenle()
    
    Dim i As Long
    
    Application.ScreenUpdating = False
    
    For i = Cells(Rows.Count, "D").End(xlUp).Row To 2 Step -1
        If Cells(i, "D") <> "" Then
            Rows(i).Copy
            Rows(i + 1 & ":" & i + Cells(i, "D") - 1).Insert Shift:=xlDown
        End If
    Next i
    
    With Application
        .ScreenUpdating = True
        .CutCopyMode = False
    End With
    
End Sub

.

 

[imsorrydude]

Ömer Bey çok teşekkür ederim hızlı geri dönüşünüz için, ancak şöyle bir sorunumuz var, satır sayısı 1 olanları da bir kere daha kopyalıyor şu anda. Diğer sayılarda sorun olmuyor. Bununla ilgili ufak bi ekleme yapabilir misiniz rica etsem?

 

[Ömer]

If Cells(i, "D") <> "" Then

Yukarıdaki satırı aşağıdaki gibi değiştirin.

If Cells(i, "D") > 1 Then

 

[imsorrydude]

Çok teşekkürler Ömer Bey, Elleriniz dert görmesin, hayat kurtardınız