Code tạo vùng copy (1 người xem)

[AnhThu-1976]

Nhờ Thầy cô & các bạn giúp cho trường hợp sau:
Do em thường xuyên chọn 1 vùng, rồi copy để dán sang file khác
Nên mong Thầy cô & các bạn giúp em viết 1 code như sau ( em đã cố nhưng chưa được)

Nếu checkbox 1 đã được chọn
Khi em dùng chuột chọn 1 ô bất kỳ của cột B
Ví dụ: em chọn Ô B7, thì code sẽ tạo vùng bôi đen từ B7:K8
Số dòng dược chọn là dựa vào ô A7 có giá trị 2, nghĩa là 2 dòng được chọn
Vùng B7:K8 sau khi được chọn thì sẽ được copy

-----------
Ví dụ khác: Nếu em chọn ô B10, thì code sẽ tạo vùng bôi đen từ B10:K15
Số dòng dược chọn là dựa vào ô A10 có giá trị 6, nghĩa là 6 dòng được chọn
Vùng B10:K15 sau khi được chọn thì sẽ được copy

Nếu tắt checkbox1 thì code không tác dụng
Xin cảm ơn

 

[befaint]

Nhờ Thầy cô & các bạn giúp cho trường hợp sau:
Do em thường xuyên chọn 1 vùng, rồi copy để dán sang file khác

Miêu tả cái chỗ màu đỏ xem như nào? Nghi ngờ cái ý tưởng chọn, copy rồi để đó...

 

[AnhThu-1976]

Miêu tả cái chỗ màu đỏ xem như nào? Nghi ngờ cái ý tưởng chọn, copy rồi để đó...

Cái này nghĩa là, sau khi nó được copy, mình sẽ sang file khác để dán nó vào

 

[ndu96081631]

Nhờ Thầy cô & các bạn giúp cho trường hợp sau:
Do em thường xuyên chọn 1 vùng, rồi copy để dán sang file khác
Nên mong Thầy cô & các bạn giúp em viết 1 code như sau ( em đã cố nhưng chưa được)

Nếu checkbox 1 đã được chọn
Khi em dùng chuột chọn 1 ô bất kỳ của cột B
Ví dụ: em chọn Ô B7, thì code sẽ tạo vùng bôi đen từ B7:K8
Số dòng dược chọn là dựa vào ô A7 có giá trị 2, nghĩa là 2 dòng được chọn
Vùng B7:K8 sau khi được chọn thì sẽ được copy

-----------
Ví dụ khác: Nếu em chọn ô B10, thì code sẽ tạo vùng bôi đen từ B10:K15
Số dòng dược chọn là dựa vào ô A10 có giá trị 6, nghĩa là 6 dòng được chọn
Vùng B10:K15 sau khi được chọn thì sẽ được copy

Nếu tắt checkbox1 thì code không tác dụng
Xin cảm ơn

Vậy nếu bạn click chuột vào B8 hoặc B11, B12 thì làm cái gì?

 

[AnhThu-1976]

Vậy nếu bạn click chuột vào B8 hoặc B11, B12 thì làm cái gì?

Nếu lỡ click vào B8, B11, B12 mà cell A8, A11, A12 ... mà không có dữ liệu thì không có chọn vùng dữ liệu nào để copy ạ

 

[befaint]

Cái này nghĩa là, sau khi nó được copy, mình sẽ sang file khác để dán nó vào

Đang cần bạn miêu tả cụ thể cái đó. Lẽ thường không ai viết code để làm mỗi việc copy rồi... sang file khác dán.

Bạn muốn lấy dữ liệu như nào thì gửi 2 cái file đó lên. Nêu file A lấy dữ liệu file B như nào, để vô đâu... Bạn hiểu chứ.

 

[AnhThu-1976]

Đang cần bạn miêu tả cụ thể cái đó. Lẽ thường không ai viết code để làm mỗi việc copy rồi... sang file khác dán.

Bạn muốn lấy dữ liệu như nào thì gửi 2 cái file đó lên. Nêu file A lấy dữ liệu file B như nào, để vô đâu... Bạn hiểu chứ.

Động tác Paste sang File khác, mình muốn làm thủ công, không muốn làm tự động, vì
1/ Do mình phải chèn thêm hàng ở sheet của file đích (file cần dán), nghĩa là mình cần Paste vào đâu là theo ý định của mình nó có thể không theo quy luật
2/ Khi dán xong mình muốn tự kiểm tra sự chính xác

Vì thế, mình muốn code giúp mình chọn vùng rồi copy, rồi mang sang file đích để dán. Dán xong rồi, mình quay lại File nguồn tiếp tục chọn vùng và copy để mang sang file đích dán ....và tiếp tục lập lại
Không biết ý tưởng mình như vậy, các bạn giúp được không?
Xin cảm ơn

 

[befaint]

Động tác Paste sang File khác, mình muốn làm thủ công, không muốn làm tự động, vì
1/ Do mình phải chèn thêm hàng ở sheet của file đích (file cần dán), nghĩa là mình cần Paste vào đâu là theo ý định của mình nó có thể không theo quy luật
2/ Khi dán xong mình muốn tự kiểm tra sự chính xác

Thử vầy xem được không...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim chk As Shape
Set chk = ActiveSheet.Shapes("Check Box 1")
If chk.OLEFormat.Object.Value = 1 Then
    If Not Intersect(Range("B7:B1000"), Target) Is Nothing Then
        Dim r: r = Target.Offset(0, -1)
        If r <> Empty Then
            Application.CutCopyMode = False
            Target.Resize(r, 10).Copy
        End If
    End If
End If
End Sub

 

[AnhThu-1976]

Thử vầy xem được không...

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
Dim chk As Shape
Set chk = ActiveSheet.Shapes("Check Box 1")
If chk.OLEFormat.Object.Value = 1 Then
    If Not Intersect(Range("B7:B1000"), Target) Is Nothing Then
        Dim r: r = Target.Offset(0, -1)
        If r <> Empty Then
            Application.CutCopyMode = False
            Target.Resize(r, 10).Copy
        End If
    End If
End If
End Sub

Code chạy ổn, cảm ơn bạn nhiều!