我无法将值复制到同一行的下一列

时间:2018-09-13 17:42:56

标签: excel vba

我是VBA的新手,我需要一些帮助。我已经找到了这段代码,并根据需要对其进行了调整,但是问题是我无法将前100个单元格复制到表中同一行的下一个列中(列E已填充,我想将值粘贴到F列)。

代码如下:

Sub variable_to_check()
Dim j As Integer, r As Range, k As Integer, dest As Range
j = 100
With Worksheets("Calibrari")
    Set r = .Range("A2")
    k = 0
    Do
        Range(r, r.Offset(j - 1, 0)).copy
        With Worksheets("INCA")
            Set dest = .Cells(Rows.count, "F").Offset(0, 0).End(xlUp).Offset(0, -1)
            dest.PasteSpecial

            'this add the text "INCA_Read" in the first column after each 100 cells 
            lr = ActiveSheet.Cells(Rows.count, "E").End(xlUp).Row + 1
            ActiveSheet.Cells(lr, "A").value = "INCA_Read"

            If k < .Range("F13").Column - 2 Then
            k = k + 1
            Else
                k = 0
            End If
        End With
        Set r = r.Offset(j, 0)
        If r = .Range("A2").End(xlDown).Offset(1, 0) Then Exit Do
    Loop
End With 
ThisWorkbook.Worksheets("INCA").Cells.EntireColumn.AutoFit
End Sub

Sub value_to_be_checked() <--in this macro i think the issue is

Dim j As Integer, r As Range, k As Integer, dest As Range
j = 100
With Worksheets("Calibrari")
    Set r = .Range("C2")
    k = 0
    Do
        Range(r, r.Offset(j - 1, 0)).copy
        With Worksheets("INCA")
            Set dest = .Cells(Rows.count, "E").Offset(0, 0).End(xlUp).Offset(0, 1)
            dest.PasteSpecial

            If k < .Range("E13").Column - 2 Then
                k = k + 1
            Else
                k = 0
            End If
        End With
        Set r = r.Offset(j, 0)
        If r = .Range("C2").End(xlDown).Offset(1, 0) Then Exit Do
    Loop
End With

End Sub

谢谢!

1 个答案:

答案 0 :(得分:0)

代替使用“复制/粘贴”,只需设置单元格的值即可:

Worksheets("INCA").Cells(Rows.count, "E").End(xlUp).Offset(0, 1) = Range(r, r.Offset(j - 1, 0)).Value2