[[20170803143820]] 『【VBA】csvファイルをコピーして同ファイル内にあ』(おかえりもん) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『【VBA】csvファイルをコピーして同ファイル内にあるExcelへペーストする』(おかえりもん)

CSVファイルを全コピーし、Excelファイルへペーストする、
というマクロの作成方法を教えてください。

【詳細】

「A」というフォルダの中に、下記のファイルが格納されています。
「A」のパス:C:\Users\user\Desktop\test1
 ?@コピー元CSVファイル.csv
 ?A貼り付け先1.xlsx
 ?B貼り付け先2.xlsx
 ?C貼り付け先3.xlsx
  ・
  ・
  ・

【想定している手順】
[1] ?@.csv を開く
[2] ?@.csvの値をコピーして、
[3] ?A.xlsx を開く
[4] ?A.xlsx へ ペーストして、
[5] ?A.xlsx を閉じる
[6] 「A」のフォルダ内のExcelへすべてペーストしたら完了

というマクロを作成したいです。

当方VBA初心者で、ネットにていろいろ調べてみたのですが、
うまくいきません。
本来ならば基礎を勉強してネットを参考にして、
試しながらマクロを作成していく、というフローだとは思いますが、
急ぎで上記のようなマクロが必要になってしまいました。

ご教示いただければ幸いです。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


  Sub A()
    Application.ScreenUpdating = False
    Set mb = ThisWorkbook
    myfdr = ThisWorkbook.Path
    fname = Dir(myfdr & "\*.csv*")
    Do Until fname = Empty
    If fname <> mb.Name Then
    Set wb = Workbooks.Open(myfdr & "\" & fname)
    wb.Worksheets.Copy after:=mb.Sheets(mb.Sheets.Count)
    wb.Close
    n = n + 1
    End If
    fname = Dir
    Loop
    Application.ScreenUpdating = True

    End Sub

(+) 2017/08/03(木) 16:23


+さん
早速のご回答ありがとうございます。
すぐに試してみて、またこちらへ連絡させていただきます。
(おかえりもん) 2017/08/03(木) 16:48

逆でしたね
(+) 2017/08/03(木) 17:19

こちらで解決した場合は↓への報告も忘れずに。

http://www.moug.net/faq/viewtopic.php?t=76041
(とおりすがり) 2017/08/03(木) 17:30


+さん
初心者すぎて申し訳ありません。
「逆」というのはなにとなにがでしょうか...

とおりすがりさん
かしこまりました!教えていただきありがとうございます、
(おかえりもん) 2017/08/03(木) 17:31


 念のため。

 複数のQ&Aサイトなどに同じ質問等の投稿をすることをマルチポストと言います。

 マルチポストはやめましょう | PC・IT・WEBの基礎知識|はじめの一歩
http://www.ippo.ne.jp/g/70.html

 ここやモーグでは禁止されてませんが(モーグでは以前はマルチポスト禁止が明示されてましたが、
 いまではその文言は削除されてます)、かといって、マルチポストが推奨されているわけではあり
 ません。多くの掲示板ではマルチポスト禁止が規約等で明示されています。マルチポスト禁止の
 サイトでマルチポストをしていけないのは当たり前ですが、容認されているサイトでも、他の
 掲示板に同様の質問をしている旨、また、解決した場合は、投稿した全てのサイトに報告が必要
 です。

 また、他のサイトで解決しました、だけ書き込む人もいますが、それは失礼です。回答を書き込
 んだ人に対しては真摯に対応し、やり取りを最後まで完結するようにしましょう。

 ※これは、相当エネルギーを必要とします。マルチポストはしないに限ります。
(とおりすがり) 2017/08/03(木) 18:48

とおりすがりさん

ご丁寧に教えてくださり、ありがとうございます。
VBAどころか、ネットマナーを違反する行為をしてしまい、
大変申し訳ありません。

これからもこちらを活用させていただこうと思いますので、
改めて気を付けて利用していこうと思います。

(おかえりもん) 2017/08/03(木) 19:02


 なんか、情報が不足しているような気がするんですけど・・

 1. Aフォルダの中に、以下の全ブックが入っているんですか?
   「CSV」、「貼り付け先XLSX」、「マクロ用XLSM」

 2.貼り付け先xlsxの何と言う「シート名」に貼り付けするんですか?
(半平太) 2017/08/03(木) 20:29

>半平太さん
情報不足していてすみません。

1.「Aフォルダ」の中に
 ・「コピー元CSVファイル.csv」
 ・「貼り付け先1.xlsx」
 ・「貼り付け先2.xlsx」
 ・「貼り付け先3.xlsx」
 ・「マクロ用.xlsm」

があります。

2.「貼り付け先1.xlsx」「貼り付け先2.xlsx」「貼り付け先3.xlsx」の
  「Sheet1」に張り付けたいです。
(おかえりもん) 2017/08/04(金) 16:33


 これでやってみてください。

 Sub copyCsvToXLSX()

     Dim myBK As Workbook, myFdr
     Dim csvBK As Workbook
     Dim aXLBK As Workbook, aXLName

     Application.ScreenUpdating = False

     Set myBK = ThisWorkbook
     myFdr = myBK.Path

     Set csvBK = Workbooks.Open(myFdr & "\コピー元CSVファイル.csv")

     csvBK.Sheets(1).Cells.Copy

     aXLName = Dir(myFdr & "\*.xlsx")

     Do Until aXLName = Empty
         If aXLName <> myBK.Name Then
             Set aXLBK = Workbooks.Open(myFdr & "\" & aXLName)
             aXLBK.Sheets("Sheet1").Cells.Select
             aXLBK.Sheets("Sheet1").Paste
             aXLBK.Close True
         End If
         aXLName = Dir()
     Loop

     csvBK.Sheets(1).Range("A1").Copy 'クリップボードを軽くする
     csvBK.Close False

     Application.ScreenUpdating = True

     MsgBox "完了"

 End Sub

(半平太) 2017/08/04(金) 18:20


>半平太さん

ありがとうございます。
すぐに試してみて、またご連絡いたします。

(おかえりもん) 2017/08/04(金) 19:18


半平太さん
ご連絡が遅くなり申し訳ございません。

昨夜、教えて頂いたコードを動かしてみたら、
希望通りの動きを確認できました!
本当に助かりました。ありがとうございます。

しかも、フォルダ内の拡張子「.xlsx」に全てペーストするという命令のおかげで、
(解読が異なっていたらすみません…。)
フォルダ内に「xlsx」のファイルを追加しても希望通りの動きをしたので感動しました。

しかしながらまだまだ勉強不足の部分が沢山ありますので、
勉強進めながら、自分でもどうにかコードを作れるようにがんばります。

みなさま本当にありがとうございました。

(おかえりもん) 2017/08/05(土) 11:51


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.