Çözüldü Verilerin Karşılarında Belirtilen Sayı Kadar Yan Sayfaya Kopyalamak

[mustafa1205]

Ek'te bulunan örnek dosyamda da açıklama yapmaya çalıştım. İlk sayfada verilerimin karşısında kaç tekrar edileceğine dair sayı verisi mevcut. Yapmak istediğim yan sayfaya tekrar edilmesi istenen sayı kadar kopyalama yapmak istiyorum. Umarım örnek dosyamda açıklayıcı olmuştur.

 

[muhasebeciyiz]

Sub KopyalaVeTekrarla()
    Dim wsAna As Worksheet
    Dim wsToplu As Worksheet
    Dim satir As Long
    Dim sonSatir As Long
    Dim tekrarSayisi As Integer
    Dim i As Long, j As Long
    Dim hedefSatir As Long
    
    Set wsAna = ThisWorkbook.Sheets("ANA")
    Set wsToplu = ThisWorkbook.Sheets("TOPLU")
    
    wsToplu.Cells.Clear
    
    sonSatir = wsAna.Cells(wsAna.Rows.Count, "A").End(xlUp).Row
    
    hedefSatir = 1
  
    For satir = 2 To sonSatir
        tekrarSayisi = wsAna.Cells(satir, 4).Value
        For i = 1 To tekrarSayisi
            For j = 1 To 4
                wsToplu.Cells(hedefSatir, j).Value = wsAna.Cells(satir, j).Value
            Next j
            hedefSatir = hedefSatir + 1
        Next i
    Next satir

    MsgBox "İşlem tamamlandı!"
End Sub

Deneyiniz

 

[mustafa1205]

Hocam çok teşekkür ederim. Elinize sağlık. Gayet güzel olmuş. İyi çalışmalar dilerim.