TẠO NÚT COPY DỮ LIỆU

[vunhai]

Dạ em kính chào các anh chị GPE. Em có một vấn đề rất mong các anh chị giúp đỡ ạ. Anh chị giúp em viết 1 code VBA về copy và paste đồng thời tạo một nút " COPY" trên sheet Form để chạy code VBA đó ạ. yêu cầu là: Khi bấm vào nút " COPY" thì dữ liệu từ Ô A2 bên sheet tên "COPY" sẽ được copy vào Ô tô màu vàng bên sheet " Form". Và mỗi lần ấn nút copy thì dữ liệu ô phía dưới Ô vừa copy ( trường hợp này là ô A3) sẽ được copy và paste vào ô tô màu vàng. Cứ như vậy mỗi lần bấm nút là copy dữ liệu phía dưới và dán vào ô tô vàng. Anh chị giúp em xem qua file đính kèm sẽ rõ hơn ạ. Rất chân thành cảm ơn anh chị.

 

[Ba Tê]

Dạ cả hai ạ. Tạo nút và code VBA để khi bấm nút COPY thì thực hiện theo như yêu cầu ghi rỏ trong file excel ạ.

Cứ lấy xuống 1 dòng rồi muốn "de" lại thì làm sao.
Làm cho bạn 1 cái nút, có 2 mũi tên lên xuống, tùy bạn chọn.
Nếu không chịu thì tính sau.

 

[SA_DQ]

Chủ bài đăng lấy macro này gắn vô nút lệnh của bạn & thử nha:

Sub CopyDuLieuODuoiLienKe()
Dim Rng As Range, sRng As Range, Cls As Range

Set Cls = [B6]
With Sheets("Copy")
    Set Rng = .[A2:A7].CurrentRegion
    If Cls.Value = "" Then
        Cls.Value = Rng.Cells(2, 1).Value
    Else
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing"
        Else
            Cls.Value = sRng.Offset(1).Value
        End If
    End If
End With
End Sub

 

[vunhai]

Cứ lấy xuống 1 dòng rồi muốn "de" lại thì làm sao.
Làm cho bạn 1 cái nút, có 2 mũi tên lên xuống, tùy bạn chọn.
Nếu không chịu thì tính sau.

Dạ em cảm ơn Ba Tê nhiều ạ. Trên cả tuyệt vời.

Bài đã được tự động gộp: 30/12/20

Chủ bài đăng lấy macro này gắn vô nút lệnh của bạn & thử nha:

Sub CopyDuLieuODuoiLienKe()
Dim Rng As Range, sRng As Range, Cls As Range

Set Cls = [B6]
With Sheets("Copy")
    Set Rng = .[A2:A7].CurrentRegion
    If Cls.Value = "" Then
        Cls.Value = Rng.Cells(2, 1).Value
    Else
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            MsgBox "Nothing"
        Else
            Cls.Value = sRng.Offset(1).Value
        End If
    End If
End With
End Sub

Dạ em cảm ơn nhiều lắm ạ.