Sütunda yazan değer kadar satır ekleme

[wezyr]

Merhabalar bir liste oluşturmam gerekiyor, Sayfa1 de ilgili satırı, satırın E sütununda yazan değer kadar Sayfa2 de altlata çoğaltması ile ilgili makro koduna ihtiyacım var. verinin tamamı ile işlem yaptığımda yaklaşık 50000 satırlık veri oluşacak. Yardımlarınız için şimdiden teşekkürler...

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim syf1 As Worksheet, syf2 As Worksheet
    Dim Bak As Long
    Dim Say As Long
    Dim Og_Say As Long
    
    Set syf1 = ThisWorkbook.Worksheets("Sayfa1")
    Set syf2 = ThisWorkbook.Worksheets("Sayfa2")
    
    For Bak = 4 To syf1.Cells(Rows.Count, "E").End(xlUp).Row
        Og_Say = syf1.Cells(Bak, "E")
        Say = syf2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        syf1.Range("A" & Bak & ":C" & Bak).Copy syf2.Range("A" & Say & ":C" & Og_Say + Say - 1)
    Next
    MsgBox "İşlem tamamlandı."
End Sub

 

[wezyr]

çok teşekkür ederim. ellerinize sağlık

Merhaba.
Aşağıdaki kodu bir modüle kopyalayıp çalıştırın.

Sub Test()
    Dim syf1 As Worksheet, syf2 As Worksheet
    Dim Bak As Long
    Dim Say As Long
    Dim Og_Say As Long
   
    Set syf1 = ThisWorkbook.Worksheets("Sayfa1")
    Set syf2 = ThisWorkbook.Worksheets("Sayfa2")
   
    For Bak = 4 To syf1.Cells(Rows.Count, "E").End(xlUp).Row
        Og_Say = syf1.Cells(Bak, "E")
        Say = syf2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        syf1.Range("A" & Bak & ":C" & Bak).Copy syf2.Range("A" & Say & ":C" & Og_Say + Say - 1)
    Next
    MsgBox "İşlem tamamlandı."
End Sub

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.