Excelマクロ実行時間1004ドキュメントが読み取り専用になる可能性があります。

Question

他のブックからデータをマスタブックに抽出しようとしました。これらのブックはすべて1つのフォルダに保存されていました。また、データを抽出する前に、フォルダ内のファイル数を確認します。ファイルが1つしかなく、それがマスターワークブックの場合は、停止してサブを終了します。

しかし、私がマクロを実行したとき、 "Do while"ループに陥ってしまいました。次に、実行時エラー1004があり、ドキュメントが読み取り専用または暗号化されている可能性があることを示します1。

パスが正しいと確信しています。

以下は私のコードです。

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim erow 
    Dim Filepath As String 
    Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\" 
    MyFile = Dir(Filepath) 

    Do While Len(MyFile) > 0 
    If MyFile = "Import Info.xlsm" Then 
     Exit Sub 
    End If 

    Workbooks.Open (Filepath & MyFile) 
    Range("F9,F12,F15,F19,F21").Select 
    Range("F21").Activate 

    ActiveWindow.SmallScroll Down:=9 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37").Select 
    Range("F37").Activate 

    ActiveWindow.SmallScroll Down:=9 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41").Select 
    Range("F41").Activate 

    ActiveWindow.SmallScroll Down:=-27 
    Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select 
    Range("F6").Activate 
    Selection.Copy 
    ActiveWorkbook.Close 

    erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 11)) 
    MyFile = Dir 
    Loop 
End Sub 

そして、私の質問は、私はループ

は実行時に1004エラーを修正する方法「ながら行います」と間違ってどこに行った私は知らない、

1. です。

私に助言を与えることはできますか？どうもありがとう！

Answer 1

自分で手動で行うのではなく、ファイルを開くためにループを使用しているようです。実行時にMyFile = Dir行が見つからないかコメントアウトされていない限り、ループが滞っている理由は不明です。

@Thomasがほとんどの場合、ソースブックがあまりに早く閉じられているため、1004エラーが発生しています。しかし、私はwkbTarget.worksheets(1).pasteを使用して値を貼り付けることができましたが、F6からF41までの間にすべてのセルを貼り付けました。

さらに、コピー範囲は11行、1列ですが、1行、11列の宛先範囲を指定しています（Cells(erow, 1), Cells(erow, 11)）。それが本当に欲しいものなら、use Transposeです。 Range()の中にCells(#,#)を使用すると、1004のエラーも発生しましたが、Cells(#,#).addressが解決しました。

Sub LoopThroughDirectory() 
    Dim MyFile As String 
    Dim wkbSource as Workbook 
    Dim wkbTarget as Workbook 
    Dim erow as single 
    Dim Filepath As String 

    Filepath = "C:\Users\uidq3022\Desktop\Backup_Version2.0_7_12\" 
    MyFile = Dir(Filepath) 

    Set wkbTarget = Workbooks(MyFile)     'Assuming the file is already open 

    Do While Len(MyFile) > 0 
    If MyFile = "Import Info.xlsm" Then Goto NextFile 'Skip the file instead of exit the Sub 

    Set wkbSource = Workbooks.Open (Filepath & MyFile) 'Set a reference to the file being opened 
    wkbSource.worksheet(1).Range("F9,F12,F15,F19,F21,F27,F30,F33,F37,F41,F6").Select 
    Selection.Copy 

    erow = wkbTarget.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row 
    wkbTarget.Worksheets("Sheet1").Paste Destination:=wkbTarget.Worksheets("Sheet1").Range(Cells(erow, 1).address) 

    wkbSource.Close 

NextFile: 
    MyFile = Dir 

    Loop 
    End Sub 

トーマスのシングルラインコピー+ペースト技術がうまく簡潔である：

は、ここに私のテイクです。そのアプローチを使用するためにコード行を並べ替えることができます。ソースオブジェクトとターゲットオブジェクトをクリアにすることをお勧めします。