0

コピーして別のワークブックに貼り付け、そのデータを新しいワークブック内の別のシートに広げようとしています。VBA は動作していますが、約 25% の確率でしか動作しません。「実行時エラー '1004': Range クラスの Select メソッドに失敗しました」というエラーが継続的に発生します。

スクリプトは次のとおりです。

Sub CopyData()

    Dim i As Range
    For Each i In Range("A1:A1000")

        Windows("data_1.xls").Activate
        Sheets("data_1").Activate
        If i.Value = 502 Then
            i.Select
            ActiveCell.Rows("1:1").EntireRow.Select
            Selection.Copy
            Windows("DataOne.xls").Activate
            Sheets("502").Range("A39").End(xlUp).Offset(1, 0).PasteSpecial
        End If
        If i.Value = 503 Then
            ........
        End If
     Next i
End Sub

失敗はi.Select毎回起こります。Next iすべての最後まで持ち出す必要がありEnd Ifますか?

4

2 に答える 2

1

値を転送するだけの場合は、アクティブ化、選択、またはコピー/貼り付けを使用する必要はありません。 

Sub CopyData()

    Dim i As Range
    Dim srcBook as Workbook
    Dim destBook as Workbook

    Application.ScreenUpdating = False

    Set srcBook = Workbooks("data_1.xls")
    Set destBook = Workbooks("DataOne.xls")

    For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
        Select Case i.Value
            Case 502
                destBook.Sheets("502").Range("A39").End(xlUp). _
                    Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case 503
                destBook.Sheets("503").Range("A39").End(xlUp). _
                    Offset(1, 0).EntireRow.Value = i.EntireRow.Value
            Case 504
                'etc
            Case Else 
                'do nothing/ or do something for non-matching
        End Select
     Next i

    Application.ScreenUpdating = True
End Sub

あなたの構造と値の宛先についてもっと知っていれば、これはさらに単純化される可能性がIf/Thenあります (それらはすべて、の値に対応する同じファイル内のシート名に移動しますiか? もしそうなら、これはさらに単純になる可能性があります.

1000行の範囲をループしているのに、A39の範囲にしか書き込んでいない理由が知りたいです（.End(xlUp)）...

コメントから更新:

Sub CopyData()

    Dim i As Range
    Dim srcBook as Workbook
    Dim destBook as Workbook
    Set srcBook = Workbooks("data_1.xls")
    Set destBook = Workbooks("DataOne.xls")

    For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
        destBook.Sheets(Cstr(i)).Range("A:A").End(xlUp).Offset(1,0). _
            EntireRow.Value = i.EntireRow.Value
     Next i
End Sub

おそらく、このサイズの配列について心配する必要はありませんScreenUpdating。この直接的な方法を使用して宛先との間で書き込みを行うと、連続して選択、アクティブ化、コピー/貼り付けしてから再度選択する場合ほどリソースを消費しません。等

于 2013-10-01T20:46:26.640 に答える