[Help] Xin Sub copy shape từ sheetA qua sheetB như lệnh Sumif

[tavantan376]

Chào mọi người!
Mình có file excel như này mọi người cho mình xin 1 sub như lệnh sumif khi nhập giá trị cột tên bên SheetA thì tự lấy cột hình dạng bên SheetA qua sheetB.
Mình xin cảm ơn!

 

[thnghiachau]

Chào mọi người!
Mình có file excel như này mọi người cho mình xin 1 sub như lệnh sumif khi nhập giá trị cột tên bên SheetA thì tự lấy cột hình dạng bên SheetA qua sheetB.
Mình xin cảm ơn!

Bạn dùng tạm cái này nha....
đánh cái tên ( vd: BTK1) vào cột A của SheetB

 

[hoangtuaotrang_hp_vn]

Bạn dùng tạm cái này nha....
đánh cái tên ( vd: BTK1) vào cột A của SheetB

Nếu tên cũ xóa đi, gõ tên khác vào, hình cũ vẫn còn và bị chồng hình mới lên, bác xem hộ chủ thớt với

 

[thnghiachau]

Nếu tên cũ xóa đi, gõ tên khác vào, hình cũ vẫn còn và bị chồng hình mới lên, bác xem hộ chủ thớt với

mình làm ra ý tưởng chính theo chủ thớt , bạn muốn "cành hoa lá hẹ" thì bạn... tùy biến nha.

 

[hoangtuaotrang_hp_vn]

mình làm ra ý tưởng chính theo chủ thớt , bạn muốn "cành hoa lá hẹ" thì bạn... tùy biến nha.

hihi, em chỉ tải về để học hỏi thôi chứ code không biết, hàm thì mù mờ anh ạ

 

[thnghiachau]

hihi, em chỉ tải về để học hỏi thôi chứ code không biết, hàm thì mù mờ anh ạ

chình lại :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Object
    If Target.Column = 1 And Target.Count = 1 And Target.Row >= 3 Then
        For Each objShape In ActiveSheet.Shapes
            If objShape.TopLeftCell.Address = Target.Offset(, 1).Address Then objShape.Delete
        Next

        If Target.Value <> "" Then
            Call CopyPicture(Sheets("SheetA"), Sheets("SheetB"), Target.Offset(, 1).Address, Target.Value)
        End If
    End If
End Sub

chú ý shape phải nằm trọn trong cell thì code mới đúng.

 

[tavantan376]

chình lại :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Object
    If Target.Column = 1 And Target.Count = 1 And Target.Row >= 3 Then
        For Each objShape In ActiveSheet.Shapes
            If objShape.TopLeftCell.Address = Target.Offset(, 1).Address Then objShape.Delete
        Next

        If Target.Value <> "" Then
            Call CopyPicture(Sheets("SheetA"), Sheets("SheetB"), Target.Offset(, 1).Address, Target.Value)
        End If
    End If
End Sub

chú ý shape phải nằm trọn trong cell thì code mới đúng.

Cảm ơn bác nhé! Để mình thử.

Bài đã được tự động gộp: 28/6/21

Nếu tên cũ xóa đi, gõ tên khác vào, hình cũ vẫn còn và bị chồng hình mới lên, bác xem hộ chủ thớt với

Cảm ơn bạn đã góp ý giúp nhé!

 

[tavantan376]

chình lại :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim objShape As Object
    If Target.Column = 1 And Target.Count = 1 And Target.Row >= 3 Then
        For Each objShape In ActiveSheet.Shapes
            If objShape.TopLeftCell.Address = Target.Offset(, 1).Address Then objShape.Delete
        Next

        If Target.Value <> "" Then
            Call CopyPicture(Sheets("SheetA"), Sheets("SheetB"), Target.Offset(, 1).Address, Target.Value)
        End If
    End If
End Sub

chú ý shape phải nằm trọn trong cell thì code mới đúng.

Bạn có thể chỉnh giúp mình 2 ý này với.
1. khi mình copy past hoặc kéo ở cột tên nó tự nhảy theo hàng loạt.
2. mình sai ở yêu đề bài tí là ở sheetA cái shape nó nằm ở giữa 3 cell à sheetB nó chỉ có 1 cell mà muốn ở 3 cell như sheetA luôn.
Mong bạn giúp đỡ.