Excel VBA質問箱 IV

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

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


7603 / 13644 ツリー ←次へ | 前へ→

【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 お礼[未読]

【38024】シートを複数のファイルにコピー
質問  サン E-MAIL  - 06/5/25(木) 11:29 -

引用なし
パスワード
   何度もすいません。

会社で会計ソフトから落としたファイルを
各部署のファイルにコピーしてメールをしています。

AブックのSheet1をBブックのSheet1、CブックのSheet1にコピーする
マクロの組み方があったら教えて頂けますでしょうか。
Aブックでマクロを実行したら、Bブック、Cブックが立ち上がり
コピーするっていうマクロの組み方ありましたら、教えて頂けますでしょうか。

宜しくお願い致します。

【38028】Re:シートを複数のファイルにコピー
回答  Kein  - 06/5/25(木) 12:02 -

引用なし
パスワード
   こんな感じかな ?

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

【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

【38031】Re:シートを複数のファイルにコピー
発言  Kein  - 06/5/25(木) 12:52 -

引用なし
パスワード
   あ、タイプミスですね。すいません。
>With Applicatin


With Application

"o" を挿入して下さい。ども。

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

引用なし
パスワード
   ▼Kein さん:
お手数お掛けしてすいません。


>あ、タイプミスですね。すいません。
>>With Applicatin
>↓
>
>With Application
>
>"o" を挿入して下さい。ども。

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