Copy và paste theo điều kiện trong VBA

[Trojan]

Dear all,
Trong file của tôi có 2 sheet. Yêu cầu đặt ra là trong thủ tục worksheet change() khi tôi nhập số hiệu thanh trong cột B ở sheet "cal" thì VBA có nhiệm vụ tìm hình dạng thanh tương ứng trong cột C ở sheet "basic" để copy và paste sang cột D trong sheet "cal". Xin chân thành cảm ơn.

 

[ThuNghi]

Dear all,
Trong file của tôi có 2 sheet. Yêu cầu đặt ra là trong thủ tục worksheet change() khi tôi nhập số hiệu thanh trong cột B ở sheet "cal" thì VBA có nhiệm vụ tìm hình dạng thanh tương ứng trong cột C ở sheet "basic" để copy và paste sang cột D trong sheet "cal". Xin chân thành cảm ơn.

Tôi thì làm kiểu khác, tạo những thanh thành hình và dùng VBA lấy vào.
Bạn nghiên cứu file sau:

 

[Trojan]

Cuối cùng thì tôi cũng tự viết được nó tuy hơi chuối. Tuy nhiên vẫn mắc một điều là khi người dùng nhập mã hình dạng bị sai và muốn sửa lại sẽ không áp dụng code chèn thêm hàng nữa mà chỉ xóa đối tượng shape cũ trong ô ở cột D cùng hàng. Xong đoạn mã có dấu đỏ của tôi mỗi lần làm như vậy thì cột ở bên phải của hàng đó lại bị dịch chuyển sang bên trái 1 cột. Các bác có thể sửa giúp tôi được không? Xin cảm ơn. Đây là đoạn mã của tôi:

Sub worksheet_change(ByVal target As Range)
Dim MyString As String, MyPosition As Range
Application.CutCopyMode = False
On Error Resume Next
If Range("row").Rows.Count - WorksheetFunction.CountA(Range("B3", target)) < 2 And target.Column = 2 Then
    If target.Offset(1, 0) <> 0 Then
        [COLOR=Red]MyString = target.Value
        Cells(target.Row, 4).Select
        ActiveCell.Shape.Select
        Selection.Delete
        Sheets("basic").Select
        ActiveSheet.Range("C" & MyString + 3).Select
        Selection.Copy
        Sheets("Cal").Activate
        Cells(target.Row, 4).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        target.Offset(1, 0).Select[/COLOR]
    Else
        target.Offset(1, 0).EntireRow.Insert shift:=xlUp
        MyString = target.Value
        Cells(target.Row, 4).Select
        Sheets("basic").Select
        ActiveSheet.Range("C" & MyString + 3).Select
        Selection.Copy
        Sheets("Cal").Activate
        Cells(target.Row, 4).Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        target.Offset(1, 0).Select
    End If
End If
Application.CutCopyMode = True
End Sub