0

2 つのワークブック (ソースとターゲット) があり、ソース ワークブックの列 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.しています。デバッグ ボタンをクリックすると、コードの 3 行目がポイントされます。

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

アップデート：

以下の回答に投稿されたコードから、3 つの列をコピーしようとしているように見えます。上記のコードを変更して、次のように 3 つの列すべてを実行できます。

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 に答える