| 
    
     |  | ▼Kein さん: ありがとうございます。
 
 早速試してみました。
 ・新しいブックを作成("Sheet1""Sheet2""Sheet3")
 ・そのブックにマクロを記述(標準モジュールに)
 ・"Sheet1"のA列にファイル名を
 ・マクロを実行するブックと同じフォルダーに入れました。
 
 試しに10ファイルやってみたのですが、実行後、すぐに下記のエラーが出ます。
 ”アプリケーション定義またはオブジェクト定義エラーが出ます。1004”
 
 お手数おかけしますが、
 よろしくお願いいたします。
 
 
 ▼Kein さん:
 >了解しました。それでは仮に・・
 >>A列にファイルの一覧
 >があるシートを "Sheet1", 表紙シートの値を転記してくるシートを
 >"Sheet2", 別紙シートの転記先を "Sheet3" として、ファイル一覧の
 >ブックは全て、マクロを実行するブックと同じフォルダーに保存されている、
 >とします。
 >これでも処理時間は長くなりそうなので、マクロを緊急停止できるように
 >キートラップコードを入れておきます。中止したいときに "Esc"キー を連打
 >してみて下さい。
 >コードは以下のようになります。シート名を適宜変更してから実行してください。
 >
 >Sub MyData_Print()
 >  Dim MyR As Range, C As Range
 >  Dim MyF As String, LkS As String
 >
 >  With Sheets("Sheet1")
 >   Set MyR = .Range("A1", .Range("A65536").End(xlUp))
 >  End With
 >  On Error GoTo ELine
 >  Application.EnableCancelKey = xlErrorHandler
 >  For Each C In MyR
 >   MyF = ThisWorkbook.Path & "\" & C.Value
 >   If Dir(MyF) <> "" Then
 >     LkS = "='" & ThisWorkbook.Path & "\[" & C.Value & "]"
 >     With Sheets("Sheet2").Range("A1:I10")
 >      .Formula = LkS & "表紙!'A1"
 >      .PrintOut Copies:=1
 >      .ClearContents
 >     End With
 >     With Sheets("Sheet3").Range("A1:B6")
 >      .Formula = LkS & "別紙!'A4"
 >      .PrintOut Copies:=1
 >      .ClearContents
 >     End With
 >   Else
 >     Debug.Print C.Value & " = 存在しない"
 >   End If
 >  Next
 >ELine:
 >  Set MyR = Nothing
 >  If Err.Number = 0 Then
 >   MsgBox "全ての印刷を終了しました" & vbLf & _
 >   "存在しないブックはイミディエイトウィンドウで確認できます"
 >  ElseIf Err.Number = 18 Then
 >   MsgBox "ユーザーの操作によってマクロを中止します"
 >  Else
 >   MsgBox "予期しないエラー発生 ! マクロを中止します" & _
 >   vbLf & Err.Number & vbLf & Err.Description
 >  End If
 >End Sub
 
 |  |