Veri çoklama

Katılım
27 Mart 2020
Mesajlar
8
Excel Vers. ve Dili
2013
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

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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:

PHP:
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
 
Katılım
27 Mart 2020
Mesajlar
8
Excel Vers. ve Dili
2013
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

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,084
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu dener misiniz:

PHP:
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
 
Katılım
27 Mart 2020
Mesajlar
8
Excel Vers. ve Dili
2013
Yusuf Bey,

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