Chuyển dữ liệu từ sheet sang sheet (1 người xem)

[minhduongct]

Mọi người cho e hỏi làm cách nào để chuyển dữ liệu từ shChungtu sang shChiTiet và lấy dữ liệu ở các cột mình muốn lấy ở shChungTu chuyển sang shChiTiet, khi thay đổi số liệu ở shChungTu thì shChiTiet cũng sẽ thay đổi theo
Em đã thử những code trên diễn đàn nhưng vẫn không được, mọi người hướng dẫn e với ạ.

 

[killitmore]

Bác copy code này vào rồi chạy coi, chú ý xóa hết nội dung bên dưới bảng của sheet chitiet roi hay chay code nhé. Thấy hay thì bấm cảm ơn nhé

Sub chuyen_dulieu()
Dim lastrow As Long
    With Sheets("Chungtu")
        lastrow = .Cells(Rows.Count, 4).End(xlUp).Row
        .Range("B11:D" & lastrow).Copy Destination:=Sheets("ChiTiet").Range("B13")
        .Range("G11:G" & lastrow).Copy Destination:=Sheets("ChiTiet").Range("E13")
        .Range("I11:L" & lastrow).Copy Destination:=Sheets("ChiTiet").Range("F13")
    End With
End Sub

 

[minhduongct]

code này chèn vào sự kiện worksheet change hay sao vậy bác!

 

[minhduongct]

Paste vào sheet2. Sự kiện active Sheet2 thì code chạy

Private Sub Worksheet_Activate()
Dim Arr, dArr, I As Long, J As Long, K As Long, sArr
sArr = Array(1, 2, 3, 6, 8, 9, 10, 11)
With Sheets("ChungTu")
    Arr = .Range("B11", .Range("B65000").End(3)).Resize(, 11).Value
End With
ReDim dArr(1 To UBound(Arr), 1 To 8)
For I = 1 To UBound(Arr)
    If Len(Arr(I, 1)) Then
        K = K + 1
        For J = 0 To UBound(sArr)
            dArr(K, J + 1) = Arr(I, sArr(J))
        Next J
    End If
Next I
    Range("B13").Resize(10000, 8).ClearContents
    Range("B13").Resize(K, 8).Value = dArr
End Sub

hì hì tks bác e đã làm được rồi ạ, vậy sau khi chuyển dữ liệu sang thì tại sheet 2 e muốn nó tự border luôn thì sao ạ

 

[minhduongct]

Private Sub Worksheet_Activate()
Dim Arr, dArr, I As Long, J As Long, K As Long, sArr
sArr = Array(1, 2, 3, 6, 8, 9, 10, 11)
Application.ScreenUpdating = False
With Sheets("ChungTu")
    Arr = .Range("B11", .Range("B65000").End(3)).Resize(, 11).Value
End With
ReDim dArr(1 To UBound(Arr), 1 To 8)
For I = 1 To UBound(Arr)
    If Len(Arr(I, 1)) Then
        K = K + 1
        For J = 0 To UBound(sArr)
            dArr(K, J + 1) = Arr(I, sArr(J))
        Next J
    End If
Next I
    Range("B13").Resize(10000, 8).ClearContents
    Range("B13").Resize(10000, 8).Borders.LineStyle = 0
    Range("B13").Resize(K, 8).Value = dArr
    Range("B13").Resize(K, 8).Borders.LineStyle = 1
    Range("B13").Resize(K, 8).Borders(xlInsideHorizontal).Weight = xlHairline
Application.ScreenUpdating = True
End Sub

tks bác e đã làm được rồi hihi