复制值，而不是列中的公式

Question

我有两个工作簿（源和目标），我想将源工作簿中的 A 列复制到目标工作簿中的 A 列。 我在上面使用了这段代码。

Sub CopyColumnToWorkbook()
    Dim sourceColumn As Range, targetColumn As Range

    Set sourceColumn = Workbooks("Source").Worksheets("Sheet1").Columns("A")
    Set targetColumn = Workbooks("Target").Worksheets("Sheet1").Columns("A")

    sourceColumn.Copy Destination:=targetColumn
End Sub

但源工作表包含带有公式的单元格。我只想复制单元格值，而不是公式。

我应该对上面的代码做哪些修改？

---

Sub BOM()
    Dim sourceColumn As Range, targetColumn As Range

    Set sourceColumn = Workbooks("MASTER").Worksheets("Sheet1").Columns("C")
    Set targetColumn = Workbooks("BOM").Worksheets("Sheet1").Columns("A")

    sourceColumn.Copy Destination:=targetColumn

    Set sourceColumn = Workbooks("MASTER").Worksheets("Sheet1").Columns("D")
    Set targetColumn = Workbooks("BOM").Worksheets("Sheet1").Columns("B")

    sourceColumn.Copy Destination:=targetColumn

    Set sourceColumn = Workbooks("MASTER").Worksheets("Sheet1").Columns("E")
    Set targetColumn = Workbooks("BOM").Worksheets("Sheet1").Columns("C")

    sourceColumn.Copy Destination:=targetColumn


End Sub

这是我用来将单元格从一个工作簿复制到另一个工作簿的代码。它在运行 Windows 7 Excel 2010 的 PC 上运行良好，但我想在使用 XP Excel 2007 的 PC 上运行相同的代码。

我在运行宏时收到Runtime error: Subscript out of range.，当我点击调试按钮时，它指向第三行代码。

Answer 1

有很多方法可以解决这个问题，这是我最喜欢的：

Sub CopyColumnToWorkbook()

    Dim iCopyingRow as long '-counter for which row we are copying at the moment
    Dim iLastRowToCopy as long '- lookup for last row to copy
    With  Workbooks("Source").Sheets("Sheet1")
        iLastRowToCopy = .Range("A" & .Rows.Count).End(xlUp).Row
    End With


    For iCopyingRow = 1 to iLastRowToCopy 
        Workbooks("Target").Sheets("Sheet1").Range("A" & iCopyingRow ).value = _
             Workbooks("Source").Sheets("Sheet1").Range("A" & iCopyingRow ).value
    Next iCopyingRow 

End Sub

更新：

看起来像您在下面发布的代码中您尝试复制三列的答案。你可以修改上面的代码来做这三列：

Sub CopyColumnToWorkbook()

    Dim iCopyingRow as long '-counter for which row we are copying at the moment
    Dim iLastRowToCopy as long '- lookup for last row to copy
    With  Workbooks("Source").Sheets("Sheet1")
        iLastRowToCopy = .Range("A" & .Rows.Count).End(xlUp).Row
    End With


    For iCopyingRow = 1 to iLastRowToCopy 
        Workbooks("Target").Sheets("Sheet1").Range("A" & iCopyingRow ).value = _
             Workbooks("Source").Sheets("Sheet1").Range("C" & iCopyingRow ).value
        Workbooks("Target").Sheets("Sheet1").Range("B" & iCopyingRow ).value = _
             Workbooks("Source").Sheets("Sheet1").Range("D" & iCopyingRow ).value
        Workbooks("Target").Sheets("Sheet1").Range("C" & iCopyingRow ).value = _
             Workbooks("Source").Sheets("Sheet1").Range("E" & iCopyingRow ).value
    Next iCopyingRow 

End Sub

Answer 2

@gimp 解决方案的一个转折点。唯一的重大变化是这避免了建立范围的串联。

Sub CopyColumnToWorkbook2()
Dim TheRange As Range
Dim ACell As Range
  Set TheRange = Application.Intersect(Range("A:A"), ActiveSheet.UsedRange)
  For Each ACell In TheRange.Cells
    Workbooks("Target.xlsx").Sheets("Sheet1").Range(ACell.Address).Value = _
      Workbooks("Source.xlsm").Sheets("Sheet1").Range(ACell.Address).Value
  Next ACell
End Sub