Copy ô lẻ tẻ và thực hiện Paste Value sang bên cạnh.

Chia sẻ bởi:hands

★★★★★

‹ Hỗ trợ về combobox phụ thuộc Dùng sự kiện Private Sub Worksheet_Change để... ›

Quảng cáo

Tình hình căng quá các bác ạ,

Em có 1 bí ẩn của khoa học là:
– Copy các ô lẻ lẻ và dán value sang bên cạnh "n" cột.
– Lần lượt dán 10 lần.
Nhờ các bác viết giúp em code ngắn gọn và khoa học hơn, em viết xong mà thấy dài dai dỏm dở quá.

7550

Option Explicit

Sub PasteV()
    Application.ScreenUpdating = False
    Dim StrSel As String
    Dim RgSub As Range, RgSubtemp As Range, cell As Range
    Dim i As Integer, x As Integer, z As Integer
    Dim SoCot As Integer
    Dim RgArr() As String
    Dim tmr As Double
    tmr = Timer
    StrSel = Selection.Address
    ReDim RgArr(1 To Selection.Count)
    RgArr = Split(StrSel, ",")
    SoCot = Application.InputBox("Muon sang may o nao???", , 1, , , , , 1)
    For i = 1 To 10
        For x = 0 To UBound(RgArr(), 1)
            Range(RgArr(x)).Copy
            Range(RgArr(x)).Offset(0, SoCot).PasteSpecial xlPasteValues
            z = z + 1
            Set RgSubtemp = Range(RgArr(x))
            If RgSub Is Nothing Then
                Set RgSub = RgSubtemp
            Else
                Set RgSub = Union(RgSub, Range(RgArr(x)))
            End If
            Debug.Print RgSub.Address
        Next x
    Next i
    MsgBox "Chay het " & z & " lan trong " & Timer - tmr & " s!!!"
    RgSub.Select
    Application.ScreenUpdating = True
End Sub

Em sẽ làm kiểu này, Copy và dán Skipblanks.

Sub Macro4()
Dim socot As Integer
Dim curcol As Integer
Dim i As Integer
curcol = ActiveCell.Column
Columns(curcol).Copy
socot = Application.InputBox("Nhap so cot", , , , , , , 1)
    For i = 1 To 10
       Columns(curcol).Copy
        Columns(ActiveCell.Column + socot).Select
        Selection.PasteSpecial Paste:=xlPasteValues, SkipBlanks:=True
    Next
End Sub

www.giaiphapexcel.com/diendan/threads/copy-%C3%B4-l%E1%BA%BB-t%E1%BA%BB-v%C3%A0-th%E1%BB%B1c-hi%E1%BB%87n-paste-value-sang-b%C3%AAn-c%E1%BA%A1nh.166960/