Xin code link dữ liệu VBA ạ !

[Nguyenphuong@2020]

Em muốn sao chép dữ liệu từ các cột từ B10, K10, O10, S10, Z10, AD10 xuống dưới trên sheet TodoList sang sheet Action Plan. Cụ thể, khi dữ liệu trong cột Z ở TodoList đủ điều kiện (không rỗng), thì dữ liệu tương ứng ở các cột từ B10, K10, O10, S10 Z10, AD10 xuống dưới( Không giới hạn số dòng ) sẽ được sao chép sang sheet Action Plan tại các cột từ B10, C10, D10, E10, G10, H10 xuống dưới ( không giới hạn số dòng ). Nhờ bạn viết code VBA giúp để có thể tự động link và tự động update khi dữ liệu thay đổi. Lưu ý các ô hàng ngang ở cả 2 sheet đã Merge 2 dòng thành 1 dòng. Các dữ liệu sẽ update tự động ( nếu dữ liệu ở sheet TodoList bị thay đổi hoặc xóa thì bên Sheet Action Plan cũng tự động update ).

 

[BuiQuangThuan]

Em muốn sao chép dữ liệu từ các cột từ B10, K10, O10, S10, Z10, AD10 xuống dưới trên sheet TodoList sang sheet Action Plan. Cụ thể, khi dữ liệu trong cột Z ở TodoList đủ điều kiện (không rỗng), thì dữ liệu tương ứng ở các cột từ B10, K10, O10, S10 Z10, AD10 xuống dưới( Không giới hạn số dòng ) sẽ được sao chép sang sheet Action Plan tại các cột từ B10, C10, D10, E10, G10, H10 xuống dưới ( không giới hạn số dòng ). Nhờ bạn viết code VBA giúp để có thể tự động link và tự động update khi dữ liệu thay đổi. Lưu ý các ô hàng ngang ở cả 2 sheet đã Merge 2 dòng thành 1 dòng. Các dữ liệu sẽ update tự động ( nếu dữ liệu ở sheet TodoList bị thay đổi hoặc xóa thì bên Sheet Action Plan cũng tự động update ).

Ban hãy kiểm tra lại. Code trong sheet Plan

Private Sub Worksheet_Activate()
    Dim a(), b(), i&, k&, c, cc, j&
    c = Array(1, 14, 18, 10, 25, 29): cc = Array(1, 2, 3, 4, 6, 7)
    With Sheets("TodoList")
        a = .Range("B10:AI" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim b(1 To UBound(a), 1 To 7)
        k = -1
        For i = 1 To UBound(a) Step 2
            If a(i, 25) <> Empty Then
                k = k + 2
                For j = 0 To UBound(c)
                    b(k, cc(j)) = a(i, c(j))
                Next
            End If
        Next
    End With
    With Sheets("Action Plan")
        .Range("B10:H10000").ClearContents
        .Range("B10").Resize(k, 6).Value = b
    End With
End Sub