0

セルの最後までプロセスを続行しようとしていますが、選択を一定の順序で変更する必要があります。コードは次のとおりです。

' C_P Macro
' copies from worksheet & pastes in new sheet
' Keyboard Shortcut: Ctrl+Shift+L

  Dim rng1 As Range
  Dim Look As String
  Dim iRow As Integer
  With Windows("Audubon-Crest-Rent-Roll-201502-1.xlsx").Activate
  Set rng1 = Range("A:A")
  ActiveCell = Range("A228")
  Do
    Windows("Audubon-Crest-Rent-Roll-201502-1.xlsx").Activate
    Range("A228:A239").Select
        Selection.Copy
    Windows("Audubon Crest Rent Roll 20150219-altered.xlsm").Activate
    Range("B17").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Windows("Audubon-Crest-Rent-Roll-201502-1.xlsx").Activate
    Application.CutCopyMode = False

    Range("A228:A239").Offset(13, 0).Select
    Selection.Copy
    Windows("Audubon Crest Rent Roll 20150219-altered.xlsm").Activate
    Range("B17").Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B18").Select
    Loop Until IsEmpty(Cells(iRow, 1))
End With
End Sub

ご覧のとおり、基本的に行うことは、11 行を選択してから、データを次のワークブックの次の行に転置コピーすることです。手順を F8 したところ、1 つの選択でうまく機能し、13 行下に移動して次の選択を行うことがわかりましたが、データを継続的に移動する方法がわかりません。常に11行を選択し、手順を実行してから13行を数え、空の行に到達するまでもう一度実行する必要があります。理想的には、特定のセル エントリを検索し、このセル エントリの次のインスタンスを見つけたら 11 行を選択するように設定できますが、13 行はパターンとして残っていると思うので、13 行をカウントダウンするだけで問題ありません。

だから、私の困惑は、行の選択を可変にする方法だと思います。コードを調べると、行の選択が具体的な値であることがわかります。そのため、マクロを実行しても下に移動せず、指定したセルだけが実行されます。どうすれば細胞を下に移動させることができますか?

4

1 に答える 1

1

範囲を使用して何かを行うためにワークブックをアクティブ化する必要はありません。むしろ、最初に範囲がどのワークブックにあるかを修飾することにより、非アクティブなワークブックの範囲を使用して何かを行うことができます。同じことがワークシートと範囲にも当てはまります。確かに、投稿しているコードサンプルで問題を引き起こしているのはそれではありません。実際には触れていないためですが、コードが読みにくくなっています。

問題の解決策の 1 つは、次のようなマクロです。

Sub Copy_Paste
    Dim sourceBook As Workbook, destBook As Workbook, sourceRange As Range, destRange As Range

    Set sourceBook = Workbooks("Audubon-Crest-Rent-Roll-201502-1.xlsx")
    Set destBook = Workbooks("Audubon Crest Rent Roll 20150219-altered.xlsm")

    Set sourceRange = sourceBook.Worksheets(<name of sheet the data is in as string>).Range("A228:A239")
    Set destRange = destBook.Worksheets(<name of sheet the data shall be copied to as string>).Range("B17")

    Do
        sourceRange.Copy
        destRange.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False

        Set destRange = destRange.Offset(1, 0)
        Set sourceRange = sourceRange.Offset(13, 0)
    Loop Until IsEmpty(sourceRange)
End Sub

ご覧のとおり、名前を付けてコピーする範囲を定義し、Setステートメントを使用してそれらがどこにあるかを Excel に伝えます。ループの反復ごとに、宛先範囲を 1 行下に移動します。これを再度設定し、 Offset-propertyを使用して、前の宛先範囲から 1 行オフセットさせます。ソース範囲についても同じことを行いますが、コードサンプルで行っていたように見えたため、13 行ずらしています。

これが役立つことを願っています！

于 2015-03-16T22:14:02.990 に答える