- ベストアンサー
エクセルで複数ファイルからコピーをする方法
- エクセルを使用して複数のファイルから部分的にコピーして貼り付ける方法を教えてください。
- マクロを使ってフォルダ内の複数のファイルから特定の列のデータを順番にコピーして他のファイルに貼り付ける方法を教えてください。
- エクセルのマクロを使用して、複数のファイルから決まった列のデータを順番にコピーして他のファイルに貼り付ける方法を教えてください。
- root38_001
- お礼率21% (3/14)
- その他MS Office製品
- 回答数6
- ありがとう数6
- みんなの回答 （6）
- 専門家の回答
質問者が選んだベストアンサー
こんにちは。 サンプルコードです。 処理にコメントを付記しましたので処理を実行する前にコメントを順に読んで質問者さんの意図するコードかを確認してから試してください。 なお、こちらでは、質問者さんのブックの内容について関知しておりませんので動作の確認は一切行っていません。 また、文字数制限で全部のコードを一度に載せられませんので、 二つに分けて提示します。質問者さんの方でつなげてください。 Sub Sample() Dim myPath As String 'このブックのパス Dim DataFile As String 'Dir()で開くブック名 Dim CopyBook As Workbook '開いたブック Dim DataSht As Worksheet 'このブックの貼り付けシート Dim i As Long '貼り付け行カウンタ '（使用状況に合わせて） '画面更新の停止、イベント機能の無効、手動計算） 'Application.ScreenUpdating = False 'Application.EnableEvents = False 'Application.Calculation = xlCalculationManual With ThisWorkbook 'このブックの貼り付けシート Set DataSht = .Worksheets(1) 'このブックのパスを調べる myPath = .Path & "\" '取り出すファイル名を取得する DataFile = Dir(myPath & "*.xls", vbNormal) '貼り付け行カウンタの初期化 i = 1 '取り出すファイルがなくなるまで繰り返し Do While DataFile <> "" 'ファイル名に"日報"という文字が含まれていたら If InStr(1, DataFile, "日報") > 0 Then '読み取り専用でブックを開く（開いたブックをCopyBookに代入する） Set CopyBook = Application.Workbooks.Open( _ Filename:=myPath & DataFile, ReadOnly:=True) 'ファイル名に"日報1"という文字が含まれていたら If InStr(1, DataFile, "日報1") > 0 Then '開いたファイルの１番目のシートの"B34:B38"をコピー CopyBook.Worksheets(1).Range("B34:B38").Copy '貼り付けシートの"C"列の i 行目に行列入替で貼り付け DataSht.Range("C" & i).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True '開いたファイルの１番目のシートの"C33:C38"をコピー CopyBook.Worksheets(1).Range("C33:C38").Copy '貼り付けシートの"H"列の i 行目に行列入替で貼り付け DataSht.Range("H" & i).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True
その他の回答 (5)
- OtenkiAme
- ベストアンサー率77% (69/89)
こんにちは。 ブックが開かれているということは、その後のコピー処理がうまく機能していなくて、ファイル名の条件判定がまずいか、コピーする場所がずれていると思います。 ステップ実行で動作を確認されては如何でしょうか？ Alt+F8でマクロ名を選び、ステップインをクリックします。 F8を押すたびに処理を実行していきます。 それで、If InStr(1, DataFile, "日報1") > 0 Then 以下の処理で If InStr(1, DataFile, "日報1") > 0 Then 内の処理も ElseIf InStr(1, DataFile, "日報2") > 0 Then 内の処理も ステップインされないということは、"日報1"や"日報2"の条件が違っていると思います。 また、 CopyBook.Worksheets(1).Range("B34:B38").Copy のようなコピーをしている時、コピーしているセル範囲が違っていたりしないでしょうか？ その辺りをステップ実行で確認してみてください。
- OtenkiAme
- ベストアンサー率77% (69/89)
こんにちは。 '取り出すファイルがなくなるまで繰り返し Do While DataFile <> "" の下の 'ファイル名に"日報"という文字が含まれていたら If InStr(1, DataFile, "日報") > 0 Then の箇所を 'ファイル名がこのブック名でなく、ファイル名に"日報"という文字が含まれていたら If DataFile <> .Name And _ InStr(1, DataFile, "日報") > 0 Then に修正してください。失礼いたしました。
補足
どうもありがとうございます。 最後まで全て開いて保存したようなのですが、 BOOKには何もコピーされていません。 何がおかしいのでしょうか？ 度々すみません、もう少しのところまで来たと思いますので よろしくお願いします。
- OtenkiAme
- ベストアンサー率77% (69/89)
続きです。先程のコードの下につなげてください。 'ファイル名に"日報2"という文字が含まれていたら ElseIf InStr(1, DataFile, "日報2") > 0 Then '開いたファイルの１番目のシートの"B31:B36"をコピー CopyBook.Worksheets(1).Range("B31:B36").Copy '貼り付けシートの"N"列の i 行目に行列入替で貼り付け DataSht.Range("N" & i).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True '開いたファイルの１番目のシートの"D31:D36"をコピー CopyBook.Worksheets(1).Range("D31:D36").Copy '貼り付けシートの"T"列の i 行目に行列入替で貼り付け DataSht.Range("T" & i).PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=True '貼り付け行カウンタを1増やす i = i + 1 Else End If '警告表示を無効 Application.DisplayAlerts = False '読み取り専用で開いたブックを閉じる CopyBook.Close SaveChanges:=False '警告表示を有効 Application.DisplayAlerts = True Set CopyBook = Nothing End If '次のファイル名を取り出す DataFile = Dir Loop 'このブックを保存 .Save Set DataSht = Nothing End With '（使用状況に合わせて） '自動計算、イベント機能を有効、画面更新を有効 'Application.Calculation = xlCalculationAutomatic 'Application.EnableEvents = True 'Application.ScreenUpdating = True End Sub
補足
ありがとうございます。 早速試してみたところエラーが出てしまいました。 先ず"日報リスト"という、まっ更なブックを開いて、そのブックに標準プロシージャを追加して、いただいたコードをコピペしました。 それからマクロの実施をしましたところ、作業が進んでいるようでしたが途中で以下のメーッセージが出ました。 "日報リストxlsは既に開いています。2重に開くと、これまでの変更内容は破棄されます。日報リストxlsを開きますか？" いいえを押すと、'Open'メソッドは失敗しました：'Workbooks'オブジェクトと表示され、デバッグを押したところ Set CopyBook = Application.Workbooks.Open( _ Filename:=myPath & DataFile, ReadOnly:=True) の部分が黄色表示になっています。 私のやり方がおかしいのでしょうか？それともどこか設定を変えなければならないのでしょうか？ お忙しいところすみませんが、ご教授ください。
- OtenkiAme
- ベストアンサー率77% (69/89)
こんにちは。 補足の回答ありがとうございました。 日付順に並んでいるということなので、この部分についての処理は割愛して作成します。 頭の中では出来上がっていますが、これから用事があるので、後でサンプルコードを作って提示します。<(_ _)> 以下の文は、昨日書き置きした回答文です。記録したコードを整理することで、共通点や規則性を見出すことができますのでコードを提示する間、記録したコードの編集にチャレンジしてみてください。 －－－－－－－－－－ これからもVBAを使っていくという前提で記録したマクロの編集方法を書いておきます。 まず、質問者さんが"970305日報1.xls"をアクティブにして閉じるまでの記録したコードの作業を書き出しましたので読んでみてください。 "970305日報1.xls"をアクティブにした "B34:B38"を選択した コピーした "日報リスト.xls"をアクティブにした "C1"を選択した 形式を選択して貼り付けた（行列入替） "970305日報1.xls"をアクティブにした "C33:C38"を選択した コピーした "日報リスト.xls"をアクティブにした "H1"を選択した 形式を選択して貼り付けた（行列入替） "日報リスト.xls"を保存した "970305日報1.xls"をアクティブにした "970305日報1.xls"を閉じた それで…、実際になさりたいことは、 "970305日報1.xls"ブックの（シート1の）"B34:B38"をコピーする "日報リスト.xls"ブックの（シート1の）"C1"に行列入替で貼り付ける "970305日報1.xls"ブックの（シート1の）"C33:C38"をコピーする "日報リスト.xls"ブックの（シート1の）"H1"に行列入替で貼り付ける "日報リスト.xls"ブックを保存する "970305日報1.xls"ブックを閉じる ということですよね？ 作業を記録した時は、仕方なくブックやセルをアクティブにしたり選択するのであって、実際の処理には必要のない処理なんです。 それで、ブックやシート、セルに対する処理では、ほとんどの場合、Activateや、Select～Selectionなどを省略し、前後のコードを編集してつないで書くことができ、画面を切り替えたり、選択することをなくすことによって画面のちらつきがなくなり、処理も速くなります。例えば、上記の処理の Windows("970305日報1.xls").Activate Range("B34:B38").Select Application.CutCopyMode = False’←（エクセルが勝手に行ったかEscを押した） Selection.Copy は、当初の目的の処理のとおり、次のように編集することができます。 （"970305日報1.xls"ブックの（シート1の）"B34:B38"をコピーする） WorkBooks("970305日報1.xls").Worksheets(1).Range("B34:B38").Copy Windows("hogehoge.xls")は、ウィンドウを操作する時につかうコードなのでブックを指定する時は、Workbooks("hogehoge.xls")を使います。また、前にも回答しましたが、セルは、複数のシートに存在しますから記録されなくても必ずシート名を書く癖をつけるとよいと思います。 編集方法を書いた書籍は、なかなかないのですが、これからVBAを使うなら必ず必要な作業になるので覚えておいてください。 では。後で……。
- OtenkiAme
- ベストアンサー率77% (69/89)
こんにちは。 エクセル君にさせたい内容は分かりました。 …が、コピーの規則性をきちんと決められてから組んだ方が良いと思います。 …それで、まず、記録されたコードを見ますと "970305日報1.xls"の（不明シートの）"B34:B38"をコピー "日報リスト.xls"の（不明シートの）"C1"に行列を入れ替えて貼付 "970305日報1.xls"の（不明シートの）"C33:C38"をコピー "日報リスト.xls"の（不明シートの）"H1"に行列を入れ替えて貼付 "日報リスト.xls"を保存 "970305日報1.xls"を閉じる "970305日報2.xls"の（不明シートの）"B31:B36"をコピー "日報リスト.xls"の（不明シートの）"N1"に行列を入れ替えて貼付 "970305日報2.xls"の（不明シートの）"D31:D36"をコピー "日報リスト.xls"の（不明シートの）"T1"に行列を入れ替えて貼付 "日報リスト.xls"を保存 "970305日報2.xls"を閉じる "970306日報1.xls"の（不明シートの）"B34:B38"をコピー "日報リスト.xls"の（不明シートの）"C2"に行列を入れ替えて貼付 "970306日報1.xls"の（不明シートの）"C33:C38"をコピー "日報リスト.xls"の（不明シートの）"H2"に行列を入れ替えて貼付 "日報リスト.xls"を保存 "970306日報1.xls"を閉じる ： ： ということになりますが、これらの処理の規則性をエクセル君に伝えるように説明してください。 （不明シートの）と書いたのは、セルは他のシートにも存在するからです。 回答者側には、質問者さんのブックの状態が分かりませんので記録で得られなかったシート名も書いてください。一枚しかないブックなら Worksheets(1) のように指定して構いません。 それと、Dir()でファイルを開かせようとしていますが、順番に開いてくれるわけではないのです。 以下のサンプルを"日報リスト.xls"の標準モジュールにコピペしてマクロを実行し、ファイル名が希望のとおりリストアップされるか確認してみてください。 Sub MakeFileList() Dim myFile As String Dim ActSht As Worksheet Dim i As Long With ThisWorkbook Set ActSht = .Worksheets.Add myFile = Dir(.Path & "\*.xls", vbNormal) i = 1 Do While myFile <> "" If myFile <> .Name Then ActSht.Cells(i, 1).Value = myFile i = i + 1 End If myFile = Dir Loop Set ActSht = Nothing End With End Sub たぶん、シート名が順番には、取り出せないはずですから、望みの処理をする場合は、リストアップしたファイルリストを並べ替えてから順番に開いて処理することになると思います。 回答者側では、1と2が必ず存在するかどうかも分かりませんので、アドバイスできるようもう少し状況を詳しく説明していただければと思います。
補足
どうもありがとうございます。 サンプルを実行してみたところファイルが順番に取り出せました。 ファイル名が日付になっているため 970305日報1.xls 970305日報2.xls 970306日報1.xls 970306日報2.xls ・ ・ と全て日付順に並んでくれました。 シートに関してですが、 970305日報1.xlsのシートは１つでシート名は5日となっています。 970305日報2.xlsも同じく１つで5日。 970306日報1.xlsも１つで6日という名前になっています。 元になるブック"日報リスト"はシート１つでSheet1です。 恐れ入りますがよろしくお願いします。
お礼
すみません解決しました。 サイトを探したらシートをアクティブにすればよさそうなので、 CopyBook.Worksheets(1).Range("B33:B38").CopyをCopyBook.ActiveSheet.Range("B33:B38").Copyで 無事データのコピーができました。 長々と本当にありがとうございました。 これからはもっと勉強したいと思います。親切丁寧にありがとうございました。 またなにかありましたらお願いします、今度は少しは上達した形で質問できるよにします。
補足
原因がわかりました。 コピー元のワークシート名を入れるとコピーされました。 説明が悪くてすみません。 コピー元のファイル（970305日報1.xls）はシートは1つなのですが 名前が日付の名前になっています。上記のファイルだとシート名が "5日"。ですので、worksheet(1)の（）の中をファイル名の日付を参照 しなければならないようです。 度々すみません、よろしくお願いします。