Veri çoklama

[guneylife]

Merhaba,
Verilerimi çoklamak istiyorum. bu konuda yardımcı olabilir misiniz?

Kırmızı işaretli alandaki her bir satırı, sarı işaretli alan ile birlikte çoklayarak yapıştırmak istiyorum. İstenen mavi bölgedeki alan şeklinde olacaktır. Veri fazla olduğu için uzun zamanımı almaktadır. Bunu aşağıdaki linkten tabloyu indirerek ifade edebilirim. Yardımcı olabilir misiniz?

https://we.tl/t-wgrHGPzS1o

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz. Yalnız dosyanızda alt kısımlarda (986. satırdan itibaren) verilerde karışıklık var, ürün kodu yok vs. Onları düzeltmeniz gerekebilir:

Sub cokla()
sonA = Cells(Rows.Count, "A").End(3).Row
sonF = [F3].End(xlDown).Row
eski = Cells(Rows.Count, "I").End(3).Row
Range("I1:N" & eski).ClearContents
For i = 3 To sonA
    yeni = Cells(Rows.Count, "I").End(3).Row + 1
    Range("F3:G" & sonF).Copy Cells(yeni, "M")
    Range("I" & yeni & ":I" & yeni + sonF - 3).Select
    Range("A" & i & ":D" & i).Copy Range("I" & yeni & ":I" & yeni + sonF - 3)
Next

End Sub

 

[guneylife]

Çok teşekkür ederim. Elinize sağlık.

 

[guneylife]

Merhaba,
Çoklama ile ilgili bir isteğim olacaktır.

Yeşil ile işaretli olan K2 hücresi içindeki her bir satır için Sarı bölgeli alanı çoklamak istiyorum bu konuda yardımcı olabilir misiniz? Bu şekilde 750 satır çoklayacağım.

Bunu aşağıdaki linkten tabloyu indirerek ifade edebilirim. Yardımcı olabilir misiniz?

İndirme bağlantısı
https://we.tl/t-zoEfvcQzBT

Teşekkürler

 

[YUSUF44]

Aşağıdaki makroyu dener misiniz:

Sub kopyala()

    son = Cells(Rows.Count, "K").End(3).Row
    For i = son To 2 Step -1
        If Cells(i, "K") <> "" Then
            dizi = Split(Cells(i, "K"), Chr(10))
            If UBound(dizi) > 0 Then
                Rows(i).Copy: Rows(i + 1 & ":" & i + UBound(dizi)).Insert Shift:=xlDown
                For j = 0 To UBound(dizi)
                    Cells(i + j, "K") = dizi(j)
                Next
            End If
        End If
    Next
    Application.CutCopyMode = False
   
End Sub

 

[guneylife]

Yusuf Bey,

çok teşekkür ederim. Elinize sağlık. Makro çalıştı.