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

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

2 个答案: