hücre değeri kadar o satırdan kopyalama

[yst10]

Selamlar,
Diyelim ki, C3 hücresinde 5 değeri var, bu değerin olduğu satırı, tablonun altına, toplam 5 kez kopyalamak için nasıl bir kod oluşturabiliriz? Eğer bu değer 5 değil, 1 ise hiç bir şey değişmeyecek, 2 ise 1 adet aynı satırdan kopyalayacak.
Yardımlarınız için teşekkür ederim.
Saygılar, sevgiler.
Yavuz Tümer

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub KOPYALA()
    If [C3] > 1 Then Rows(3).Copy Rows("4:" & [C3] + 3)
End Sub

 

[yst10]

Selam hocam,
nasılsın, umarım herşey gönlünüzcedir.
hemen deniyorum.
Kendinize çok ama çok iyi bakın.
Sevgiler,
Yavuz

 

[yst10]

Yok Hocam,
Bu kod değil, şöyle açıklamayı denemek istiyorum.
A kolonundan M kolonuna uzanan bir tablom var,
C kolonunda değerler var1-2-3-4 gibi.
Bir kod ile, c kolonundaki değerler kadar her bir satırı tablonun altına doğru çoğaltmak istiyorum.
mesela, C2 de 3 var ise, o satırın 2 kere daha kopyalanmasını istiyorum.
veya 4 var ise, o satırı 3 kez daha kopyalamak.
eğer bu değer 1 ise de kopyalama yapmadan geçsin, işleme, aşağı doru devam etsin.
Umarım açıklayabilmişimdir.
Gecenin bu vakti, sağol hocam.

 

[Korhan Ayhan]

Selamlar,

Tablonun altına dediğiniz kısmı anlamadım. Örnek dosya eklerseniz çözüme çok hızlı bir şekilde ulaşabiliriz.

 

[yst10]

Selamlar,

Tablonun altına dediğiniz kısmı anlamadım. Örnek dosya eklerseniz çözüme çok hızlı bir şekilde ulaşabiliriz.

Hocam, örnek dosya ekte, ilgine tekrar teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Sub AKTAR()
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    S2.Cells.Clear
    SATIR = 1
    For X = 1 To S1.[A65536].End(3).Row
    If S1.Cells(X, 3) <> "" Then
    For Y = 1 To S1.Cells(X, 3)
    S2.Range("A" & SATIR & ":G" & SATIR).Value = S1.Range("A" & X & ":G" & X).Value
    SATIR = SATIR + 1
    Next
    End If
    Next
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "&#304;&#350;LEM&#304;N&#304;Z TAMAMLANMI&#350;TIR.", vbInformation
End Sub

 

[yst10]

Korhan hocam,
Çok teşekkür ederim. Sorunsuz çalışıyor.
Ellerine sağlık.
Yavuz Tümer