Giúp code Copy dữ liệu tuần tự vào 1 sheet. (1 người xem)

[thuantam]

Chào các bạn
Mình đang cần một đoạn code thể thực thi công việc sau.

Sheet "tinhtoan" như sau:

[TABLE="width: 500"]
[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]NGAY[/TD]
[TD]MA SAN PHAM[/TD]
[TD]SO LUONG THUNG CHAN[/TD]
[TD]SO LUON THUNG LE[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]29/07/2016[/TD]
[TD]850[/TD]
[TD]20[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]29/07/2016[/TD]
[TD]860[/TD]
[TD]11[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]29/07/2016[/TD]
[TD]930[/TD]
[TD]15[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]29/07/2016[/TD]
[TD]150[/TD]
[TD]11[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD]29/07/2016[/TD]
[TD]673[/TD]
[TD]5[/TD]
[TD]1[/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]29/07/2016[/TD]
[TD]240[/TD]
[TD]6[/TD]
[TD]0[/TD]
[/TR]
[TR]
[TD]8[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]9[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]11[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]13[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]14[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[/TABLE]

Yêu cầu ở sheet "copy", chép dữ liệu NGAY và MA SAN PHAM 850 thành 20 dòng (20+0) tiếp sau đó chép NGAY va MA SAN PHAM 860 thành 12 dòng (11+1). Sau đó tiến hàng đén cách mã sau.

Các bạn vui lòng giúp đỡ với.
Cám ơn rất nhiều.

 

[anhdepjai]

Bạn gửi file đi. Mù mờ thế ai giúp được

 

[thuantam]

Mình gửi file đính kèm.
Các bạn giúp mình với nhé.
Cám ơn rất nhiều

 

[Ba Tê]

Mình gửi file đính kèm.
Các bạn giúp mình với nhé.
Cám ơn rất nhiều

Bạn copy code này vào Module và Run thử xem sao nhé.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Ngay As Long, Num As Long, Ma As String
sArr = Sheets("tinhtoan").Range("A2", Sheets("tinhtoan").Range("A2").End(xlDown)).Resize(, 4).Value
ReDim dArr(1 To 10000, 1 To 2)
For I = 1 To UBound(sArr)
    Num = sArr(I, 3) + sArr(I, 4)
    Ngay = sArr(I, 1): Ma = sArr(I, 2)
    For J = 1 To Num
        K = K + 1
        dArr(K, 1) = Ngay: dArr(K, 2) = Ma
    Next J
Next I
Sheets("copy").Range("A2").Resize(K, 2) = dArr
End Sub

 

[thuantam]

Cám ơn bạn Ba Tê nhiều, code đã chạy được.
Đổi biến Ngay As Long --> Ngay As String.

Bạn có thể giùm mình đổi mau khi nhảy mã với.
Cám ơn rất nhiều.

 

[Lê Duy Thương]

Cám ơn bạn Ba Tê nhiều, code đã chạy được.
Đổi biến Ngay As Long --> Ngay As String.

Bạn có thể giùm mình đổi mau khi nhảy mã với.
Cám ơn rất nhiều.

thử code này nữa xem sao

Sub value()
Dim i As Long, j As Long
Sheet3.Range("2:65536").Clear
For i = 2 To Sheet1.[a1].CurrentRegion.Rows.Count
j = Sheet1.Range("C" & i) + Sheet1.Range("d" & i)
Sheet3.Range("a65536").End(3).Offset(1).Resize(j, 2).value = Sheet1.Range("a" & i).Resize(1, 2).value
Next


End Sub

 

[thuantam]

Bạn Ba Tê,

Mình làm tương tự cho file như thế này mãi không được.
Bạn vui lòng giúp code với.
Cám ơn rất nhiều.

 

[thuantam]

Mình đã làm được rồi,
Nhưng xảy ra trường hợp, khi thay số lượng khác và mã khác thì nhảy mã nhưng số lượng vẫn lấy giá trị cũ.
Mong giúp đỡ.
Xin cám ơn.