0
votes

I have two workbooks (source and target) and I want to copy column A in the source workbook to column A in the target workbook. I used this code for the above.

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

But the source sheet contains cells with formulas. I just want to copy the cell values, but not formulas.

What changes should I make to the above code?


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

This is the code I used to copy the cells from one workbook to another. It's working fine on my PC which is running Windows 7 Excel 2010, but I want to run the same code on PCs which are using XP Excel 2007.

I am getting Runtime error: Subscript out of range. while running the macro, and when I click debug button, it points to the third line of code.

2

2 Answers

1
votes

There are many ways to approach this, this is my favorite:

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:

It looks like form your code posted below in an answer that you are trying to copy three columns. you can modify the above code to do all three columns like this:

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
0
votes

A spin on @gimp's solution. The only material change is this avoids concatenation to build the ranges.

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