Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43730 / 76732 ←次へ | 前へ→

【38030】Re:シートを複数のファイルにコピー
お礼  サン E-MAIL  - 06/5/25(木) 12:32 -

引用なし
パスワード
   ▼Kein さん:
ありがとうございます。

コピーは出来たのですが、エラーが出てきてしまいます。
御忙しい所、申し訳ございませんが
マイドキュメントのファイルはどうやったら、良いか教えて頂けますでしょうか。

Sub Sh_Copy()
 Dim WB As Workbook, MyB As Workbook

 Application.ScreenUpdating = False
 If Workbooks.Count > 1 Then
   For Each WB In Workbooks
    If WB.Name <> ThisWorkbook.Name Then
      WB.Close True
    End If
   Next
 End If
 With ThisWorkbook
   .Worksheets("Sheet1").UsedRange.Copy
   Set MyB = Workbooks.Open(.Path & "\Book1.xls")
   MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
   MyB.Close True: Set MyB = Nothing
   Set MyB = Workbooks.Open(.Path & "\Book2.xls")
 End With
 MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
 MyB.Close True: Set MyB = Nothing
 With Applicatin
   .CutCopyMode = False  ← ここが黄色くなってしまいます。
   .ScreenUpdating = True
 End With
 MsgBox "コピー処理を終了しました", 64

End Sub

どこを直した宜しいでしょうか。
申し訳ございません。教えて頂けますでしょうか。


>こんな感じかな ?
>
>Sub Sh_Copy()
> Dim WB As Workbook, MyB As Workbook
>
> Application.ScreenUpdating = False
> If Workbooks.Count > 1 Then
>   For Each WB In Workbooks
>    If WB.Name <> ThisWorkBook.Name Then
>      WB.Close True
>    End If
>   Next
> End If
> With ThisWorkBook
>   .Worksheets("Sheet1").UsedRange.Copy
>   Set MyB = Workbooks.Open(.Path & "\B.xls")
>   MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
>   MyB.Close True: Set MyB = Nothing
>   Set MyB = Workbooks.Open(.Path & "\C.xls")
> End With
> MyB.Worksheets("Sheet1").Range("A1").PasteSpecial
> MyB.Close True: Set MyB = Nothing
> With Applicatin
>   .CutCopyMode = False
>   .ScreenUpdating = True
> End With
> MsgBox "コピー処理を終了しました", 64
>End Sub
0 hits

【38024】シートを複数のファイルにコピー サン 06/5/25(木) 11:29 質問
【38028】Re:シートを複数のファイルにコピー Kein 06/5/25(木) 12:02 回答
【38030】Re:シートを複数のファイルにコピー サン 06/5/25(木) 12:32 お礼
【38031】Re:シートを複数のファイルにコピー Kein 06/5/25(木) 12:52 発言
【38032】Re:シートを複数のファイルにコピー サン 06/5/25(木) 12:54 お礼

43730 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free