『「VBA」複数Excelシートを複数ブックに仕分ける方法』（ぽいたろう）
いつも掲示板を拝見させていただきまして、参考にさせております。
VBAは初心者で、コピーしながら変更して使用しているのですが、現在行っているコードが上手くいかなくて困っております。
【結果的にしたいこと】
１つのフォルダ内に Excel ブック が200件（個々の研修結果のデータ）があり、20部署のファイルに一気に仕分けたいです。
現在、ある方のコードをそのまま利用しました。事前準備で
１：新しいファイルにそれぞれ20部署のファイルを作成。
２：新しいファイル内に『200件のExcel』ブックを入れる。
３：仕分けを実行するマクロExcelを作成し、
A列に『200件のExcelの名前』、B列に「仕分け番号」を記入（1.2.3...）の表を作成。
４：下記のコードを入れて、実行
[A列] [B列]
『名前』 「仕分け番号」 ファイル名 1 阿部 3 営業課 2 伊藤 2 事務課 3 上野 3 営業課 4 江原 1 経理課 5 大川 2 事務課
Sub 仕分け()
'変数の型を宣言
Dim file_name As String
Dim i As Integer
'A列が空欄になるまで繰り返し処理を実施
Do Until Cells(2 + i, 1) = ""
file_name = Cells(2 + i, 1)
'仕分け番号が1の場合
If Cells(2 + i, 2) = 1 Then
Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name
Else
'仕分け番号が2の場合
If Cells(2 + i, 2) = 2 Then
Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\事務課\" & file_name
Else
'仕分け番号が3の場合
If Cells(2 + i, 2) = 3 Then
Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\営業課\" & file_name
End If
End If
End If
i = i + 1
Loop
End Sub
ちなみに最初のこの部分でエラーが発生します。（エラー53：ファイルが見つかりません）
If Cells(2 + i, 2) = 1 Then
Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name
20部署あるので増やしていけばいいと記入があったのですが、
このコードからつまづいたので、もし気付いたことや、
他に違うコードがありましたらご教授いただけますと幸いです。
お返事は翌日になる可能性があります。よろしくお願いいたします。
＜ 使用 Excel：Microsoft365、使用 OS：Windows10 ＞
＞１：新しいファイルにそれぞれ20部署のファイルを作成。
＞２：新しいファイル内に『200件のExcel』ブックを入れる。
ファイルにファイル？ ファイルにブック？
（xlg） 2023/09/27(水) 10:24:45
＞ちなみに最初のこの部分でエラーが発生します。（エラー53：ファイルが見つかりません）
＞ If Cells(2 + i, 2) = 1 Then
＞ Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name
Name？？ 何がしたいの？
（xlg） 2023/09/27(水) 10:34:46
まずこれですが、宣言されたばかりのiはたぶん0ですね。
するとCells(2,1)からスタートになりますが、阿部さんスキップしてませんか？
番号の付け方が悪いだけでCells(1,1)にタイトル行があるなら問題ありません。
>Name ThisWorkbook.Path & "\" & file_name As ThisWorkbook.Path & "\経理課\" & file_name
名前を変更しようとしていますが、file_nameには「阿部」とか入ってますよね。
「阿部」って名前のファイルはないですよね？だから、ファイルがないと言われてるのでは？
あるとしても、「阿部.xlsx」とかではないでしょうか？
（ゆたか） 2023/09/27(水) 10:38:12
＞するとCells(2,1)からスタートになりますが、阿部さんスキップしてませんか？
ここはパッと見同じことを思いましたが、1 行目は見出しがあんだろうと勝手に解釈しました。
（xlg） 2023/09/27(水) 10:42:18
（マクロ苦手） 2023/09/27(水) 11:33:04
1. １つのフォルダ内に【担当の名前になっている】ブック（ファイル）が200個ほどある 2. ↑を【マクロブック】に用意した【担当者と所属部署の対応表】に基づき 3. 1のフォルダから所属部署のフォルダへ【ファイルを移動させたい】
ということではないですか？そういう話であれば、
1. フォルダ内のファイルを巡回し、拡張子が【.xls?】ならば担当者名を調べる 2. 「1」で調べた担当者の所属部署を対応表で調べる 3. 「2」で調べた部署のフォルダへ「1」のファイルを移動する
という動きを繰り返しすればよいので、『200件のExcelの名前』「仕分け番号」といったものはいらないように思われます。
（もこな２ ） 2023/09/27(水) 12:06:50
他の作業に追われながら進む気力がなくなったのは事実です。
みなさんの知恵でしたらコードが間違っているのがすぐ分かるのかと思ってお力をお借りしようといたしました。
そして、ファイルではなくフォルダーでした。申し訳ありません。
最後に仰ってくださった
＞1 行目は見出しがあんだろうと勝手に解釈しました。
その通りでございます。
ゆたか様
新しいフォルダー内にExcelの名前で「阿部」というのはあるのですが、
そのExcelの名前自体に「.xlsx」が必要ということでしょうか？
マクロ苦手様
私の説明が下手で申し訳ありません。
もなこ２様
流れを整理していただいてありがとうございます。
この形でしたら再度調べてできそうな気がしてきました。
（ぽいたろう） 2023/09/27(水) 12:57:01
【Ｂパターン】
#ファイル名で移動先フォルダが判断できるが規則性がなく人間が確認して判断する必要がある場合 1. ファイル名をリストアップする（マクロ１） 2. 人の手で移動先フォルダを決定する（手作業） 3. リストに沿ってファイルを移動する（マクロ２）
【Ｃパターン】
#ファイル名で所属部署が判断でき、所属部署ごとのブックごとに取りまとめたい 1. ファイル名から、所属部署をしらべる 2. （開いてなければ）所属部署のブックを開く 3. 「1」のシートをコピーして↑の末尾に挿入する
なので、まずはやりたいことを正確（フォルダ、ブック（ファイル）、シートなどを明確）にして箇条書きで整理されてはどうですか？
（もこな２ ） 2023/09/27(水) 13:23:27
>新しいフォルダー内にExcelの名前で「阿部」というのはあるのですが、 >そのExcelの名前自体に「.xlsx」が必要ということでしょうか？
Windowsの標準設定では既知の拡張子（.txtとか.xlsxとか、.より後の部分）は省略されます。
よって、「阿部.xlsx」というファイル名は「阿部」とのみ表示されます。
設定を変更して拡張子を調べてください。新しく作ったのなら.xlsxだと思いますが、
古いファイルを引き継いでいれば、.xlsの場合もありますし、
情報交換用のファイルなら.csvのこともあります。
参考
https://pc-karuma.net/windows-10-show-explorer-file-name-extension/
（ゆたか） 2023/09/27(水) 14:32:04
例）
file_name → filename & ".xlsx"
P.S.
現在はセルに名前を入力して一つずつファイル名を指定していますが、
そのフォルダにあるすべてのファイルを対象にして順次処理していくこと
もできます。ただし、名前と所属の対応はどこかで必要となりますね。
現在はif分をネストしていますが、Select Caseとかを使えば読みやすくなります。
まあ、動けば良いという考え方もあるかとは思います。
（ゆたか） 2023/09/27(水) 14:43:10
ゆたか様
ご丁寧にURLありがとうございます。.xlsxでした。
＞そのフォルダにあるすべてのファイルを対象にして順次処理していくこともできます。
この方法も良いと思いますので、調べてみます。
xlg様
まさにその通りなのですが、今後のことも考えてVBAに手を出しました(-_-;)
今回この方のようにしたかったのですが、伝わらなくて申し訳ありません。
（最初からURL乗せておけばよかったです＞＜）
https://www.higashisalary.com/entry/file-sorting
違う視点を得られたのでこの情報を基に違う方法も考えてみます。
良い方法がありましたら、ご教授いただけますと幸いです。頼りっぱなしで申し訳ありません。
（ぽいたろう） 2023/09/27(水) 17:34:42
質問と関係ないことも含め何点か。
■１
↓は、やってることとコメントが一致していません
Set r = .Cells(8, 4).CurrentRegion 'D列8行目にフィルタ
さらに言うと、【r】に格納されるのは【D8セルが"含まれる"表範囲】であって【D列8行目以下のセル範囲】ではありません。
■２
＞D列に～というデータがあるとき
提示のような並びであればそれなりに幸せな結果になると思いますが、D列（の初めのほうに）重複があれば↓は破綻しませんか？
r.AutoFilter 4, r(i, 4)
■３
＞オートフィルターの切り替えをループする
↑の意味が、【実行する（ボタンを押す）】たびに【抽出条件】を【一定のパターン】の範囲で変わるようにしたいという話ならば以下のように考えてみてはどうでしょうか？
1. オートフィルタ自体は手動で設定
2. 【別シート】のA列にリストを用意しておく（データをコピペして重複の削除をすればok）
3. 以下のマクロを研究して、適宜カスタマイズ
Sub さんぷる()
Stop 'ブレークポイントの代わり
Static i As Long
Dim 順番 As Long
Dim 抽出条件 As String
i = i + 1
With Worksheets("別シート")
順番 = i Mod (.Cells(Rows.Count, "A").End(xlUp).Row + 1)
If 順番 = 0 Then
抽出条件 = "<>"
Else
抽出条件 = .Cells(順番, "A").Value
End If
End With
Debug.Print i & "回目の実行です" & vbLf & "リスト" & 順番 & "番目の条件は【" & 抽出条件 & "】です" & vbLf
'ここにオートフィルタで抽出する命令を記述
End Sub
なお、オートフィルタが設定されている範囲は↓で取得できます。
【ワークシートオブジェクト】.Autofilter.Range
（もこな２ ） 2023/09/27(水) 17:40:57
（もこな２ ） 2023/09/27(水) 17:46:15
本当に考えて下さりありがとうございます＞＜
返信が遅くなって申し訳ありません。
（ぽいたろう） 2023/09/27(水) 17:58:03
Sub リストアップ()
Dim フォルダ As String, ファイル名 As String
Dim 行 As Long
フォルダ = "C:\hogehoge\"
ファイル名 = Dir(フォルダ & "*.xls?")
Do Until ファイル名 = ""
行 = 行 + 1
ActiveSheet.Cells(行, "A").Value = ファイル名
ファイル名 = Dir()
Loop
End Sub
'=============================
Sub リネーム()
Dim フォルダ As String
Dim 行 As Long
フォルダ = "C:\hogehoge\"
With ActiveSheet
For 行 = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
Debug.Print フォルダ & .Cells(行, "A").Value
Debug.Print " ↑を↓にリネーム"
Debug.Print フォルダ & .Cells(行, "B").Value & "\" & .Cells(行, "A").Value
Debug.Print
Next
End With
End Sub
（もこな２ ） 2023/09/27(水) 18:41:34
へーえ、なんかすごいことやってるなあ。。。
ん？待てよ？えっ、こんなことExcelのマクロでやる必要あるんだっけ？
というわけで、今更なんですが。。。
1.移動させたいファイルのあるフォルダにテキストファイルを１つ作成します。
ファイル名は「移動.txt」とでもして、内容は以下の通り（５行）とします。
※保存するときに文字コードはANSIにしてください（既定値のUTF-8ではうまく動作しません）
2.拡張子を変更します
ファイル名を「移動.txt」から「移動.bat」に変更します。
3.そのファイルをダブルクリックします
以上です。
いずれにしても、名前と所属の関係を管理する必要があるなら、この方が簡単じゃないですか？
（ゆたか） 2023/09/28(木) 09:23:21
フォルダがない状態で実行すると、エクセルブックがフォルダ名になり、さらに上書きされます。
（データは常にバックアップを取るようにしましょう）
もし、フォルダも同時に作りたければ、先頭に
mkdir 営業課
mkdir 事務課
mkdir 経理課
の３行を付け加えてください。
P.S.
なお、拡張子が.batのファイルはバッチファイルと呼ばれていて、いろんな処理ができます。
以下のようなバッチファイルを作ると、ディレクトリにある拡張子が.xlsxのファイル一覧を一覧.txtに書き込んでくれます。
dir /B *.xlsx > 一覧.txt
（ゆたか） 2023/09/28(木) 11:06:58
ゆたか様
ご教授いただいた方法で実行してみました。できました。
ありがとうございます！
（ぽいたろう） 2023/09/28(木) 11:29:14
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.