Coppy dữ liệu sang sheet khác

[thach1995]

chào cả nhà. cả nhà giúp em với ạ
em muốn khi ở bất kỳ ô nào trên cốt B ở sheet 2024 có dữ liệu thì sẽ coppy dữ liệu tương ứng của dòng đó ở các cột tên khách hàng,mã khuôn,số máy thử, mã nhân viên lấy hàng, tên nhân viên lấy hàng sẽ tự động chuyển qua bên sheet kết quả ạ

 

[zzzsxxx01]

chào cả nhà. cả nhà giúp em với ạ
em muốn khi ở bất kỳ ô nào trên cốt B ở sheet 2024 có dữ liệu thì sẽ coppy dữ liệu tương ứng của dòng đó ở các cột tên khách hàng,mã khuôn,số máy thử, mã nhân viên lấy hàng, tên nhân viên lấy hàng sẽ tự động chuyển qua bên sheet kết quả ạ

Trong khi chờ hỗ trợ thì tặng bạn code chủ cuối của mình.

 

[cantl]

coppy

Dạo này trào lưu dùng từ sai chính tả. Cóp bi mới đúng nhé.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DongDangDung&, DongCuoiBenKia&
    If Not Intersect(Target, Range("B3:B10000")) Is Nothing And Target.Value <> "" Then
        DongDangDung = Target.Row
        DongCuoiBenKia = Sheet14.UsedRange.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row + 1
        Sheet14.Cells(DongCuoiBenKia, 5) = Sheets("2024").Cells(DongDangDung, 5)
        Sheet14.Cells(DongCuoiBenKia, 7) = Sheets("2024").Cells(DongDangDung, 6)
        Sheet14.Cells(DongCuoiBenKia, 8) = Sheets("2024").Cells(DongDangDung, 8)
        Sheet14.Cells(DongCuoiBenKia, 16) = Sheets("2024").Cells(DongDangDung, 33)
        Sheet14.Cells(DongCuoiBenKia, 17) = Sheets("2024").Cells(DongDangDung, 34)
            End If
End Sub

 

[VetMini]

DongCuoiBenKia = Sheet14.UsedRange.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row + 1
Sheet14.Cells(DongCuoiBenKia, 5) = Sheets("2024").Cells(DongDangDung, 5)
Sheet14.Cells(DongCuoiBenKia, 7) = Sheets("2024").Cells(DongDangDung, 6)
Sheet14.Cells(DongCuoiBenKia, 8) = Sheets("2024").Cells(DongDangDung, 8)
Sheet14.Cells(DongCuoiBenKia, 16) = Sheets("2024").Cells(DongDangDung, 33)
Sheet14.Cells(DongCuoiBenKia, 17) = Sheets("2024").Cells(DongDangDung, 34)

set rg1 = Sheet14.Cells(Sheet14.UsedRange.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row + 1, 1).EntireRow
set rg2 = Sheets("2024").Cells(Target.Row, 1).EntireRow
rg1.Cells(5) = rg2.Cells(5)
rg1.Cells(7) = rg2.Cells(6)
rg1.Cells(8) = rg2.Cells(8)
rg1.Cells(16) = rg2.Cells(33)
rg1.Cells(17) = rg2.Cells(34)

 

[cantl]

set rg1 = Sheet14.Cells(Sheet14.UsedRange.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row + 1, 1).EntireRow
set rg2 = Sheets("2024").Cells(Target.Row, 1).EntireRow
rg1.Cells(5) = rg2.Cells(5)
rg1.Cells(7) = rg2.Cells(6)
rg1.Cells(8) = rg2.Cells(8)
rg1.Cells(16) = rg2.Cells(33)
rg1.Cells(17) = rg2.Cells(34)

Hehe. Gọn hơn hẳn và dễ nhìn nữa bác.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DongDangDung&, DongCuoiBenKia&
    Dim rg1 As Range, rg2 As Range
    If Not Intersect(Target, Range("B3:B10000")) Is Nothing And Target.Value <> "" Then
        DongDangDung = Target.Row
        DongCuoiBenKia = Sheet14.UsedRange.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row + 1
        Set rg1 = Sheet14.Cells(DongCuoiBenKia, 1).EntireRow
        Set rg2 = Sheets("2024").Cells(DongDangDung, 1).EntireRow
        rg1.Cells(5) = rg2.Cells(5)
        rg1.Cells(7) = rg2.Cells(6)
        rg1.Cells(8) = rg2.Cells(8)
        rg1.Cells(16) = rg2.Cells(33)
        rg1.Cells(17) = rg2.Cells(34)
    End If
End Sub

 

[thach1995]

Trong khi chờ hỗ trợ thì tặng bạn code chủ cuối của mình.

cảm ơn bạn. mình đã sử dụng thử ok rồi nhưng bên kết quả mình vẫn muốn có thể dùng cả nhập tay nữa có đc k ạ

Bài đã được tự động gộp: 17/1/24

Dạo này trào lưu dùng từ sai chính tả. Cóp bi mới đúng nhé.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim DongDangDung&, DongCuoiBenKia&
    If Not Intersect(Target, Range("B3:B10000")) Is Nothing And Target.Value <> "" Then
        DongDangDung = Target.Row
        DongCuoiBenKia = Sheet14.UsedRange.Cells(ActiveSheet.Rows.Count, "E").End(xlUp).Row + 1
        Sheet14.Cells(DongCuoiBenKia, 5) = Sheets("2024").Cells(DongDangDung, 5)
        Sheet14.Cells(DongCuoiBenKia, 7) = Sheets("2024").Cells(DongDangDung, 6)
        Sheet14.Cells(DongCuoiBenKia, 8) = Sheets("2024").Cells(DongDangDung, 8)
        Sheet14.Cells(DongCuoiBenKia, 16) = Sheets("2024").Cells(DongDangDung, 33)
        Sheet14.Cells(DongCuoiBenKia, 17) = Sheets("2024").Cells(DongDangDung, 34)
            End If
End Sub

cảm ơn mn rất nhiều ạ

 

[HUONGHCKT]

cảm ơn bạn. mình đã sử dụng thử ok rồi nhưng bên kết quả mình vẫn muốn có thể dùng cả nhập tay nữa có đc k ạ

Bài đã được tự động gộp: 17/1/24

cảm ơn mn rất nhiều ạ

Gửi @thach1995:
Bạn có lẽ chưa hình dung ra hết các tình huống có thể xảy ra.
đó là cứ mỗi khi bạn kích hoạt 1 ô trong cột B (sửa ô hoặc Enter) thì code sẽ chạy, nhưng nếu dòng dữ liệu của Dải ô đang active đó đã được nhập vào sh KetQua rồi, thì lần kích hoạt này sẽ thêm 1 lần nhập nữa tức là sẽ nhập trùng vào dòng cuối. Để khắc phục tình trạng nhập trùng này bạn phải cung cấp cho nó 1 mã duy nhất. khi code chạy nó sẽ kiểm tra bên Sheet KetQua xem mã duy nhất này đã nhập chưa? nếu chưa nhập thì code chạy tiếp (nhập) , nếu đã có thì hỏi bạn có muốn nhập lại không? nếu trả lời Yes==> nhập đè lên dữ liệu cũ, nếu trả lời No, bỏ qua (thoát khỏi sub)>
Tôi tin là bạn tự làm được.
Chúc thành công.