使用VBA复制和粘贴仅包含值的单元格

时间:2018-06-08 13:21:47

标签: excel-vba vba excel

如何更新我的代码,以便我只复制带有数据的单元格。它搜索并选择带有标题“instruction”或“direction”的列。由于它选择了整个列,因此出现了不匹配的大小错误。我希望它只复制原始工作表中的非空单元格并将其粘贴到新工作表的b列中的下一个空单元格下面。这就是我所拥有的,但我还没有测试它,我知道语法在某处可能不正确

Sub CopyData(ORIGINAL As Worksheet, newWS As Worksheet)
Dim Title As Range
Dim LastRow As Long
Dim dest As Range

With ORIGINAL.Rows(1)
Set Title = .Find("Instruction")
If Title Is Nothing Then Set Title = .Find("Direction")
End With

'Get last used row, and add 1 (for next one)
LastRow = newWS.Cells(Rows.Count, 1).End(xlUp).Row + 1

If Not Title Is Nothing Then
    Title.EntireColumn.RemoveDuplicates Columns:=1, Header:=xlNo
    Set Title = Title.EntireColumn.SpecialCells(2)
    Set dest = newWS.Cells(LastRow, 1).End(xlUp).Offset(0, 1)
    Title.copy dest
    newWS.Columns.AutoFit
Else
    MsgBox "Error"
End If

End Sub

1 个答案:

答案 0 :(得分:0)

这可能对您有所帮助。说我们有:

enter image description here

我们的目标是:

  • 找到Instruction
  • 仅复制包含该列数据的单元格
  • 粘贴到该列
  • 中任何现有数据下方的 F 列中

代码:

Sub Soso()
    Dim rToCopy As Range, rDest As Range

    Set rToCopy = Rows("1:1").Cells.Find(What:="Instruction")
    Set rToCopy = rToCopy.EntireColumn.SpecialCells(2)

    Set rDest = Cells(Rows.Count, "F").End(xlUp).Offset(1, 0)
    rToCopy.Copy rDest
End Sub

之后:

enter image description here

注意:

  • 没有复制空单元格。
  • 我的代码是为常量设计的,而不是公式

如果您在Instruction列中有公式,请使用SpecialCells(-4123)