特定のローカルフォルダ内に
①マスターファイル.xls
②xxxx担当者Axxxx.xls
③ 〃 B 〃
~
⑩ 〃 I 〃
というファイルがあり、①~⑩には同じ[yyyy年m月][master1][...2][...3]という4シートがあり、②~⑩のファイルの[yyyy年m月]というシートのデータを①のファイルの[yyyy年m月]のシートへ順にコピペでまとめたいのですが、webを見ていろいろ試しても上手くいきません
vbaは全くの初心者なので、こまかく解説を入れてもらえると助かります
<条件>
1.excelのバージョンは利用者毎にバラバラで2003~2010が使われています
2.②~⑩のコピー元の範囲はB51からAE120まで(50行名目がデータのタイトル行でそれ以前は集計されたデータがあります
3.①の貼付け先はB45から貼付けをしたい(44行目がデータのタイトル行でそれ以前は集計されたデータがあり、①のファイルは他支店と共有するので行や列の変更はできません)
4.貼付け順は担当者AからIまで指定をしたい(ファイル名を指定したい)
5.各シート名は毎月更新されていくので、シート名の[yyyy年m月]が変わります
6.それぞれのデータは値だけでなく、[master1][…2][…3]シートからデータを読み込んだ関数が含まれます
①~⑩は同じmasterデータを読み込むので関数を変える必要はありません(値貼付けになってもOKです)
7.[yyyy年m月]シートの特定の列には条件付き書式が含まれています
8.②~⑩のコピー元は担当者が行を追加したり削除したりするのでvbaで処理ができるようにしたいです
9.今後条件が変わっても修正できるようにできるだけ解説をつけてもらえると助かります
どうぞよろしくお願いいたします<m(__)m>
No.1
- 回答日時:
複数ブックのデータを一つのシートにまとめるVBAを組みました。
★★★★★★★★★★★★★★★★★★★★★★
※必ず、マスターファイル.xlsを複製して、複製ファイルでテストをしてください。複製したブックのファイル名は何でも構いません。マスターファイルコピー.xlsでも仮.xlsでもOKです。
自動でブックを保存するコードは記述していませんので、予期せぬ結果になったら保存をせずに閉じれば元のブックのままです。
★★★★★★★★★★★★★★★★★★★★★★
xxxx担当者○xxxx.xlsファイルは値を取り出すだけなので、こちらは複製する必要はないです。
---------------------------準備-------------------------------------
複製したマスターファイルにシートを追加して、シート名を「ファイル一覧」にしてください。
シート「ファイル一覧」のA1からA9に、②xxxx担当者Axxxx.xls~⑩xxxx担当者Ixxxx.xlsを【拡張子も含めて】入力してください。(添付画像のようにしてください)
※ファイル名を入力したら、シートを非表示にしても問題ありません。
マクロコードの18行目
PathName = "F:\データ\" を、データフォルダのパスに書き換えてください。
例 PathName = "C:\Users\user\マイフォルダ\"
※パスの最後に【\】をつけてください。
----------------------------------------------------------------------
マスターファイル及び担当者ファイルのデータシート[yyyy年m月]を、自動で探すようにしましたが、ブックファイルのシート構成によってはうまく作動しません。
今回記述したコードでは、次の条件を両方とも満たすシートを、データシートとみなします。
①シート名の5番目の文字が[年](1~4番目の文字は半角・全角を問いません)
②最後の文字が[月]
二つの条件を満たすシートが同一ブックに複数ある場合は、データシートを自動で探すことができません。
[2015年11月][2014年5月][2013年9月][出荷予定年月]
☝条件を満たすシート名の例
[14年2月]
☝条件を満たさないシート名の例
この条件では都合が悪い場合は教えてください。別の方法を考えます。
このコードは、マスターファイル(複製)のモジュールに貼り付けてください。
-------------------------マクロコード------------------------------------
Sub Macro01()
Dim MasterBook As Workbook
Dim PathName As String
Dim FileSh As Worksheet
Dim i As Long, k As Long
Dim PasteCell As Long
Dim MasterSh As Long
Dim Value1
PasteCell = 45
'最初のデータを貼り付ける行番号
Set MasterBook = ThisWorkbook
Application.ScreenUpdating = False
'画面の更新を停止
MasterBook.Activate
Set FileSh = Sheets("ファイル一覧")
'マスターファイルに[ファイル一覧]という名称のシートが存在しないとエラーになります。
PathName = "F:\データ\"
'パス名を変更してください。
For i = 1 To Sheets.Count
If Mid(Sheets(i).Name, 5, 1) = "年" And _
Right(Sheets(i).Name, 1) = "月" Then
MasterSh = i
Exit For
End If
Next
'このFor~Nextでマスターファイルのシートから、データシートを探します。
For k = 1 To FileSh.Range("A" & Rows.Count).End(xlUp).Row
Workbooks.Open Filename:=PathName & FileSh.Cells(k, 1).Value
'[ファイル一覧]シートのA1からA列の最終行までの値を順番に取り出して、
'PathNameと連結させたものが、Workbooks.OpenのFilenameになります。
For i = 1 To Sheets.Count
If Mid(Sheets(i).Name, 5, 1) = "年" And _
Right(Sheets(i).Name, 1) = "月" Then
Value1 = Sheets(i).Range("B51:AE120")
Exit For
End If
Next
'xxxx担当者○xxxx.xlsからデータシートを探して、B51:AE120の【値】を取り出します。
'取り出すのは【値】のみです。計算式は計算結果の値です。書式などは取り出しません。
MasterBook.Sheets(MasterSh).Range("B" & PasteCell).Resize(70, 30) = Value1
'マスターブックのデータシートに転記します。Resize(70,30)→B51:AE120の行数70、列数30
ActiveWorkbook.Close
'xxxx担当者○xxxx.xlsブックを閉じます。
PasteCell = PasteCell + 70
'データを貼り付ける行番号に、B51:AE120の行数70を加算します。
'初期値 45→115→185→255…
Next
'次のxxxx担当者○xxxx.xlsブックを開きます。
Application.ScreenUpdating = True
End Sub
-----------------------------------------------------------------
不具合が生じましたら、詳細を教えていただければ対策できるかもしれません。
No.2
- 回答日時:
PathName = "F:\データ\"はコードの18行目ではなく、もう少し後ろでした。
(23行目あたりです)ありがとうございます
バッチリ出来ました!
但し説明不足(私の説明が間違っていました)で大変申し訳ないのですが、各担当者ファイルのデータを貼付けの際には空欄は詰めて張り付けたいんです…
担当者により80行までや120行目までバラバラで、毎月データ数(行数)も変わってきます
解決策はありますでしょうか
No.3ベストアンサー
- 回答日時:
No.1のコードを修正しました。
xxxx担当者○xxxx.xlsを次々に開いて転記するのはNo.1のコードと同じです。
各xxxx担当者○xxxx.xlsの【B51~B列の最終行のAE列】を転記するデータにしました。
マスターブックの転記開始位置は【B列の最終行+1】なので、異なる行数のデータを転記しても、既にデータが存在している行に転記してしまうことはありません。
各xxxx担当者○xxxx.xlsの転記が完了したら、マスターブックのデータを最終行から調べて、転記したデータの空白行を削除します。【B列からAE列に一つも値が入力されていない行】
Sub Macro02()
Dim MasterBook As Workbook
Dim PathName As String
Dim FileSh As Worksheet
Dim i As Long, k As Long, t As Long
Dim PasteCell As Long
Dim MasterSh As Long
Dim Value1
Set MasterBook = ThisWorkbook
Application.ScreenUpdating = False
MasterBook.Activate
Set FileSh = Sheets("ファイル一覧")
'マスターファイルに[ファイル一覧]という名称のシートが存在しないとエラーになります。
PathName = "F:\データ\"
'パス名を変更してください。
For i = 1 To Sheets.Count
If Mid(Sheets(i).Name, 5, 1) = "年" And _
Right(Sheets(i).Name, 1) = "月" Then
MasterSh = i
Exit For
End If
Next
'このFor~Nextでマスターファイルのシートから、データシートを探します。
For k = 1 To FileSh.Range("A" & Rows.Count).End(xlUp).Row
Workbooks.Open Filename:=PathName & FileSh.Cells(k, 1).Value
'[ファイル一覧]シートのA1からA列の最終行までの値を順番に取り出して、
'PathNameと連結させたものが、Workbooks.OpenのFilenameになります。
For i = 1 To Sheets.Count
If Mid(Sheets(i).Name, 5, 1) = "年" And _
Right(Sheets(i).Name, 1) = "月" Then
t = Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row
Value1 = Sheets(i).Range(Cells(51, 2), Cells(t, "AE"))
Exit For
End If
Next
'xxxx担当者○xxxx.xlsの【B列の最終行】を貼り付けるデータの最終行としました。
MasterBook.Sheets(MasterSh).Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(t - 50, 30) = Value1
' masterbook.Sheets(mastersh).range("B" & rows.Count).
'マスターブックのデータシートに転記します。転記開始位置はマスターブックのB列の最終行+1です。
'B列の最終行+1に転記するので、データの行数が変わっても問題ありません。
ActiveWorkbook.Close
'xxxx担当者○xxxx.xlsブックを閉じます。
Next
'次のxxxx担当者○xxxx.xlsブックを開きます。
For k = Range("b" & Rows.Count).End(xlUp).Row To 45 Step -1
If WorksheetFunction.CountIf(Range(Cells(k, 2), Cells(k, 10)), "*") = 0 Then
Rows(k).Delete shift:=xlUp
End If
Next
'マスターブックの最終行から45行の【B列からAE列に一つも値がなかった場合、その行を削除します】
Application.ScreenUpdating = True
End Sub
バッチリ出来ました!
本当にありがとうございます
別のQへも回答ありがとうございます
そちらはこれから試してみますm(_ _)m
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) 【マクロ】同じフォルダ内にある複数ブックから1つのブック内の1シートにデータを集めたい 6 2022/09/28 18:16
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- その他(Microsoft Office) マクロVBAについて 1 2022/09/06 18:12
- Excel(エクセル) VBA ふたつの同じ様式シートのセルをコピーしたい 2 2023/03/08 15:28
- Excel(エクセル) VBA セルの値と同じ名前のシートにデータを貼り付けするやり方を教えてください 2 2022/05/17 16:26
- Excel(エクセル) Excelで、別シートの表のステータスに伴った動的な自動転記をしたいです。 2 2023/06/14 15:56
- Visual Basic(VBA) 【前回の続きです、ご教示ください】VBAの記述方法がわかりません。 2 2022/08/16 16:44
- Visual Basic(VBA) 【困っています2】VBA 追加処理の記述を教えてください。 2 2022/08/26 11:42
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Visual Basic(VBA) 【ご教示ください】VBAの記述方法がわかりません。 2 2022/08/12 21:28
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
Excel起動時に特定のワークシー...
-
エクセル 複数のブックを一度...
-
エクセルで抽出して別ファイル...
-
VBAでエクセルファイルを複数、...
-
VBAでブック保護非保護を判定す...
-
【困っています】VBA 追加処理...
-
エクセルで50行ごとに区切った...
-
vbaでpdfを開いて1ページ目のみ...
-
エクセルで参照しているデータ...
-
エクセルにおける,「ブック」...
-
指定ファィルの指定シートをシ...
-
Excelファイルを開いても何も表...
-
EXCELで複数のブックの特定のセ...
-
複数のセルをコピーし、別シー...
-
Excel(2010)のフィルターが保...
-
複数のExcelブックのシート1の...
-
【ExcelVBA】シートをそれぞれ...
-
【マクロ】【VBA】別ブックへの...
-
外部ブック参照が#REF!になって...
-
VBA:ワークブックを変数でActi...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルの関数 ENTERを押...
-
VBAでブックを非表示で開いて処...
-
エクセルを共有するとPCによっ...
-
WorkBooksをオープンさせずにシ...
-
エクセルで参照しているデータ...
-
エクセルで「ディスクがいっぱ...
-
Excelでブックの共有を掛けると...
-
Excelで複数ブックの同一セルに...
-
Excel(2010)のフィルターが保...
-
エクセルで別ブックをバックグ...
-
エクセルにおける,「ブック」...
-
同じフォルダへのハイパーリン...
-
ブックのピボットを別ブックに...
-
エクセルファイルを開かずにpdf...
-
エクセル2016です。「ブッ...
-
ブックの保護ができないんです...
-
エクセルで50行ごとに区切った...
-
エクセルシートの一部を送りたい
-
フォルダ内の複数ファイルから...
-
エクセル 複数のブックを一度...
おすすめ情報