Tao code copy công thức và dán giá trị dựa vào đk của giá trị cột TT (1 người xem)

[nhatthai]

giả sử tôi có 1 file như thế này, ý đồ tôi muốn tạo 1 đoạn code để khi tôi chọn một cột nào đó thì có thể copy công thức ở ô trên cùng dán công thức này (Ô màu vàng) xuống các ô còn lại trọng cột (Các Ô màu xanh) Sau đó dán lại giá trị các ô vừa được dán công thức.

Yêu cầu :
1- Dựa theo giá trị lớn nhất của cột thứ tự;
2- Để nguyên công thức ở ô trên cùng (Ô màu vàng)

Bình thường cái này tôi phải thực hiện bằng tay, còn tạo 1 macro thì nó chỉ hữu dụng trong các trường hợp cụ thể

Mong các bác giúp

 

[cadafi]

giả sử tôi có 1 file như thế này, ý đồ tôi muốn tạo 1 đoạn code để khi tôi chọn một cột nào đó thì có thể copy công thức ở ô trên cùng dán công thức này (Ô màu vàng) xuống các ô còn lại trọng cột (Các Ô màu xanh) Sau đó dán lại giá trị các ô vừa được dán công thức.

Yêu cầu :
1- Dựa theo giá trị lớn nhất của cột thứ tự;
2- Để nguyên công thức ở ô trên cùng (Ô màu vàng)

Bình thường cái này tôi phải thực hiện bằng tay, còn tạo 1 macro thì nó chỉ hữu dụng trong các trường hợp cụ thể

Bạn chép đoạn code này vào module:

Sub CopyCT()
Dim MaxRow As Integer
MaxRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
    Sheets("sheet1").Range("D5:F5").Select
    Selection.Copy
"Copy công thức:
    Sheets("sheet1").Range("D5:F" & MaxRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
"Copy và dán cứng:
Sheets("sheet1").Range("D6:F" & MaxRow).Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet1").Range("D6").Select
End Sub

Sau đó tạo một nút command và sự kiện click nút như sau:

Private Sub CommandButton1_Click()
Call CopyCT
End Sub

bạn xem file đính kèm nhé.

 

[nhatthai]

Bạn chép đoạn code này vào module:

Sub CopyCT()
Dim MaxRow As Integer
MaxRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
    Sheets("sheet1").Range("D5:F5").Select
    Selection.Copy
"Copy công thức:
    Sheets("sheet1").Range("D5:F" & MaxRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
"Copy và dán cứng:
Sheets("sheet1").Range("D6:F" & MaxRow).Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet1").Range("D6").Select
End Sub

Sau đó tạo một nút command và sự kiện click nút như sau:

Private Sub CommandButton1_Click()
Call CopyCT
End Sub

bạn xem file đính kèm nhé.

"giả sử tôi có 1 file như thế này, ý đồ tôi muốn tạo 1 đoạn code để khi tôi chọn một cột (hoặc 1 vùng) nào đó thì có thể copy công thức ở ô trên cùng dán công thức này (Ô màu vàng) xuống các ô còn lại trọng cột (Các Ô màu xanh) Sau đó dán lại giá trị các ô vừa được dán công thức"

Cái này nó chưa bao quát bạn ạ, chỉ sử dụng được trong trường hợp cụ thể thôi.
Vấn đề là trong 1 books khi ta chọn 1 dãy (=1 cột) trong bất kỳ bàng nào nào bạn ạ.

 

[nhatthai]

Nhờ các bác làm tiếp, tôi mày mò mãi mà chả được. Có lẽ do yêu cầu tôi đưa ra chưa rõ ràng
Yêu cầu :
1- Dựa theo giá trị lớn nhất của cột thứ tự;
2- Để nguyên công thức ở ô trên cùng (Ô màu vàng)
3- Thực hiện trong từng cột rời rác trong bảng tính, Tức là khi ta đưa con trỏ chuột vào ô đầu tiên của cột hoặc chọn 1 dãy ô đầu tiên của các cột liền nhau và nhấn nút command thì nó thực hiện yêu cầu 1 và 2.
Mong các bác giúp nhé

 

[salam]

Nhờ các bác làm tiếp, tôi mày mò mãi mà chả được. Có lẽ do yêu cầu tôi đưa ra chưa rõ ràng
Yêu cầu :
1- Dựa theo giá trị lớn nhất của cột thứ tự;
2- Để nguyên công thức ở ô trên cùng (Ô màu vàng)
3- Thực hiện trong từng cột rời rác trong bảng tính, Tức là khi ta đưa con trỏ chuột vào ô đầu tiên của cột hoặc chọn 1 dãy ô đầu tiên của các cột liền nhau và nhấn nút command thì nó thực hiện yêu cầu 1 và 2.
Mong các bác giúp nhé

Ý của bạn là copy từng cột theo con trỏ chuột ở ô nào thuộc cột đó thì sẽ copy cột đó vậy bạn xem file kèm nhé.

 

[nhatthai]

Ý của bạn là copy từng cột theo con trỏ chuột ở ô nào thuộc cột đó thì sẽ copy cột đó vậy bạn xem file kèm nhé.

Cái này cải tiến thêm được một chút nữa thì hay lắm

1- Có thể chọn một ô hoặc dãy ô liền nhau ở các đầu cột rồi copy và dán xuống
2- Để tránh việc copy nhầm các cột không có công thức thì kiểm tra xem ô (dãy ô) đầu cột có phải là công thức không rồi mới thực hiện, nếu không phải thì đưa ra thông báo.

Mong các bác giúp tiếp, cảm ơn nhiều.

 

[salam]

Vậy bạn sửa lại code:

Sub Dan()
Dim Dong As Integer
Dim Day As Range
Dong = WorksheetFunction.Max(Range("A1:A65536")) - 1
Set Day = Selection
Range(Cells(5, Day.Column), Cells(5, Day.Column + Day.Count - 1)).Select
If Selection.HasFormula Then
Selection.Copy
Range(ActiveCell.Offset(1, 0), ActiveCell.Offset(Dong, 0)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Else
MsgBox ("Khong phai cong thuc")
End If
Range("D6").Select
End Sub

 

[salam]

Cái này cải tiến thêm được một chút nữa thì hay lắm

1- Có thể chọn một ô hoặc dãy ô liền nhau ở các đầu cột rồi copy và dán xuống
2- Để tránh việc copy nhầm các cột không có công thức thì kiểm tra xem ô (dãy ô) đầu cột có phải là công thức không rồi mới thực hiện, nếu không phải thì đưa ra thông báo.

Mong các bác giúp tiếp, cảm ơn nhiều.

Đúng theo yêu cầu của bạn nhé.

 

[thanhtam348]

Bạn chép đoạn code này vào module:

Sub CopyCT()
Dim MaxRow As Integer
MaxRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
    Sheets("sheet1").Range("D5:F5").Select
    Selection.Copy
"Copy công thức:
    Sheets("sheet1").Range("D5:F" & MaxRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
"Copy và dán cứng:
Sheets("sheet1").Range("D6:F" & MaxRow).Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet1").Range("D6").Select
End Sub

Sau đó tạo một nút command và sự kiện click nút như sau:

Private Sub CommandButton1_Click()
Call CopyCT
End Sub

bạn xem file đính kèm nhé.

Đoạn code nầy tôi đang cần dùng, xin bạn sửa lại dùm tôi chút nhé!
cũng giống như file đính kèm nầy của bạn nhưng hàng chứa CT của tôi thì nằm chổ khác như đã định vị trong file.
Cám ơn!

 

[KhanhChi29]

Bạn chép đoạn code này vào module:

Sub CopyCT()
Dim MaxRow As Integer
MaxRow = Sheets("Sheet1").Range("A65536").End(xlUp).Row
    Sheets("sheet1").Range("D5:F5").Select
    Selection.Copy
"Copy công thức:
    Sheets("sheet1").Range("D5:F" & MaxRow).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False
"Copy và dán cứng:
Sheets("sheet1").Range("D6:F" & MaxRow).Select
Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet1").Range("D6").Select
End Sub

Sau đó tạo một nút command và sự kiện click nút như sau:

Private Sub CommandButton1_Click()
Call CopyCT
End Sub

bạn xem file đính kèm nhé.

Em có sửa lại Code của anh cadafi chạy code trong File thấy bão lỗi mọi người sửa lại giúp em với
Sub CopyCT()
Dim MaxRow As Integer
MaxRow = Sheets("Sheet4").Range("A65536").End(xlUp).Row
Sheets("sheet4").Range("F6:AI6").Select
Selection.Copy
Sheets("sheet4").Range("F6:AI" & MaxRow).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet4").Range("F7:AI" & MaxRow).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("sheet4").Range("F6").Select
End Sub

Đã biết mình Sai, nhận lỗi với thầy cô
Cái Sheet4 kia không đúng