質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

88.10%

Excel vba フォルダ内にある複数の別ブックにシートをコピーしたいのですが、上手くいきません。

受付中

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 799

score 4

タイトルの通りなのですが、試行錯誤しても中々うまくいきません。
助けてください。

現在の作成途中のコードは以下です。
Sub Sample()
Dim myPath As String
Dim myBook As String
Dim myActiveBook As Workbook
Dim myOpenBook As Workbook

Set myActiveBook = ActiveWorkbook
myPath = "C:\Users\swprj\Desktop\test\
myBook = Dir(myPath & "*.xlsx")
Do Until myBook = ""
Workbooks.Open myPath & myBook
Set myOpenBook = ActiveWorkbook
myActiveBook.Worksheets(1).Copy After:=myOpenBook.Worksheets(1)
Workbooks(myBook).Close SaveChanges:=True 
myBook = Dir

Loop
End Sub

やりたいことは、
現在開いているブックのシートを対象フォルダ内にある全てのブックにコピー(追加)したいです。
よろしくお願いします。

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 過去に投稿した質問と同じ内容の質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • Lim1213

    2019/11/18 17:05

    このプログラムはコピー元のエクセルに記載されているのですか?
    それともまた別のエクセルなのでしょうか。

    このプログラムの実行方法も含めて知りたいです。

    キャンセル

回答 2

+3

何がどうダメなのか詳細をお書きください。
先走って回答しますが、アクティブ前提の作りになっているのが原因かもしれません。
以下のように修正してみました。
内容ご確認ください。
但し、動作未検証です。

Sub Sample()
    Dim myPath As String
    Dim myBook As String
    Dim myActiveBook As Workbook
    Dim myOpenBook As Workbook

    Set myActiveBook = ActiveWorkbook
    myPath = "C:\Users\swprj\Desktop\test\
    myBook = Dir(myPath & "*.xlsx")
    Do Until myBook = ""
        'Workbooks.Open myPath & myBook
        Set myOpenBook = Workbooks.Open myPath & myBook
        'Set myOpenBook = ActiveWorkbook
        myActiveBook.Worksheets(1).Copy After:=myOpenBook.Worksheets(1)
        'Workbooks(myBook).Close SaveChanges:=True 
        myOpenBook.Close SaveChanges:=True 
        myBook = Dir

    Loop
End Sub

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2019/11/19 13:03

    ん?どういうことでしょうか。
    見せてない処理もあるってことですか?

    キャンセル

  • 2019/11/19 13:06

    いえ、コピー先をマクロ有効ブックと普通のブックで試してみたことを伝えたかったというだけです。
    その際にxlsxをxlsmに書き換えたけど結局処理としては同じで出来ませんでした。
    分かりにくくて申し訳ないです。

    キャンセル

  • 2019/11/19 13:43

    以下の手順でやってもダメですか?
    1. 新規にワークブックを作成
    2. Sheet1に何か適当に値を入力
    3. 標準モジュールに回答のコードをコピペ(追加の修正もお願いします)
    4. Sampleを実行
    5. Sheet1が各Excelファイルの2シート目にコピーされているはず
    基本これだけのはずです。
    もしこれでもダメなら、myOpenBook.Closeの行をコメントアウトして処理が終わった状態で各Excelファイルがどのような状態かを確認してみてください。

    キャンセル

0

私の環境ではうまく動いているように見えます。
同じシート名がすでにある、ベースとなるパスがそもそも間違っているなど、失敗している原因は凡ミスの可能性がありますね。

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 88.10%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる

関連した質問

同じタグがついた質問を見る

  • トップ
  • Excelに関する質問
  • Excel vba フォルダ内にある複数の別ブックにシートをコピーしたいのですが、上手くいきません。