複製值，而不是來自列的公式

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 

UPDATE：

看起來形成你的代碼，您正試圖將三個答案貼在下面列。你可以修改上面的代碼做的所有三列是這樣的：

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