0

我有两个工作簿（源和目标），我想将源工作簿中的 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.在运行宏时得到，当我单击调试按钮时，它指向第三行代码。

4

2 回答 2

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
于 2012-07-11T15:38:22.943 回答
0

@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
于 2012-07-11T23:53:14.007 回答