Tạo code cho copy dữ liệu cách dòng và paste dữ liệu vào dòng cuối (1 người xem)

[Thanh1102]

Mình có file dữ liệu đính kèm
1 - Dữ liệu bị cách dòng (sheet1) cần copy/paste sang sheet 2 có dữ liệu liên tục
2 - Khi dữ liệu tại sheet 1 được cập nhật mới. Chọn nút "Cập nhật" sẽ copy như mục (1) vào dòng kế tiếp của sheet 2

Rất mong các Anh/Chị giúp đỡ

 

[Hau151978]

Bạn gán macro này vào nút lệnh ở sheet Data:

Sub CapnhatDL()
    Dim n&, m&, rng As Range
    Application.ScreenUpdating = False
    n = Range("A" & Columns(1).Rows.Count).End(xlUp).Row - 3
    Range("A6:E" & (n + 3)).Copy Sheets("Yeucau").Range("A3")
    Sheets("Yeucau").Activate
    Range("F3").Formula = "=A3="""""
    Set rng = Range("F3:F" & n)
    rng.FillDown
    Range("A3:F" & n).Sort Range("F3")
    m = WorksheetFunction.CountIf(rng, False)
    rng.ClearContents
    Range("A" & (m + 3), "E" & n).Delete
    Application.ScreenUpdating = True
End Sub

 

[Thanh1102]

Cảm ơn bạn Hau151978. Code này đã đáp ứng được mục (1) rồi. Tuy nhiên mục (2) vẫn chưa được. Cụ thể:
"Khi dữ liệu tại sheet 1 được cập nhật/thay đổi. Chọn nút "Cập nhật" sẽ copy như mục (1) vào dòng kế tiếp của sheet "Yeucau"

Tức là: Mục đích mỗi lần nhấn nút "cập nhật" sẽ in bảng dữ liệu và copy dữ liệu từ sheet"Data" sang sheet "Yeucau" nối tiếp vào dữ liệu cũ.
Mong bạn giúp đỡ

 

[Hau151978]

Nút copy sẽ chuyển tất cả dữ liệu từ sheet Data sang sheet Yeucau mà. À bây giờ mình mới thấy cần in, thì bạn thêm lệnh range(...).printout rồi gọi sub cập nhật dữ liệu.

 

[Ba Tê]

Cảm ơn bạn Hau151978. Code này đã đáp ứng được mục (1) rồi. Tuy nhiên mục (2) vẫn chưa được. Cụ thể:
"Khi dữ liệu tại sheet 1 được cập nhật/thay đổi. Chọn nút "Cập nhật" sẽ copy như mục (1) vào dòng kế tiếp của sheet "Yeucau"

Tức là: Mục đích mỗi lần nhấn nút "cập nhật" sẽ in bảng dữ liệu và copy dữ liệu từ sheet"Data" sang sheet "Yeucau" nối tiếp vào dữ liệu cũ.
Mong bạn giúp đỡ

Thất nghiệp, viết cho bạn cái Sub này tuỳ nghi sử dụng nhé.
Chuyện In gì đó thì không tính vào đây.

Public Sub GPE()
Dim sArr(), dArr(), I As Long, J As Long, K As Long, R As Long
With Sheets("Data")
    sArr = .Range(.[A6], .[A65536].End(xlUp).Offset(2)).Resize(, 5).Value
End With
ReDim dArr(1 To UBound(sArr, 1), 1 To 5)
For I = 1 To UBound(sArr, 1)
    If sArr(I, 1) <> Empty Then
        K = K + 1
        For J = 1 To 5
            dArr(K, J) = sArr(I, J)
        Next J
    End If
Next I
With Sheets("Yeucau")
    R = .[D65536].End(xlUp).Offset(1).Row
    If K Then
        .Range("A" & R).Resize(K, 5) = dArr
        .Range("A" & R).Resize(K, 5).Borders.LineStyle = 1
        MsgBox "Ghi Xong " & K & " Dong. Hic!", , "GPE"
    Else
        MsgBox "Hic! Chang co gi de ghi.", , "GPE"
    End If
End With
End Sub

 

[Thanh1102]

Nút copy sẽ chuyển tất cả dữ liệu từ sheet Data sang sheet Yeucau mà. À bây giờ mình mới thấy cần in, thì bạn thêm lệnh range(...).printout rồi gọi sub cập nhật dữ liệu.

Lệnh in tạm thời chưa tính đến. Dữ liệu có copy sang nhưng lại đè lên dữ liệu cũ mà không nối tiếp

 

[Thanh1102]

Cảm ơn bác Ba Tê. Em đã làm được theo code của bác.