あなたは色々なファイルを、担当者別のフォルダへ振り分けて保存するのが面倒だと思ったことはありませんか？
1個や2個ならいいですが、毎日何十個もファイル名を確認して、担当者のフォルダに移動するのは大変ですよね。
エクセルのマクロを使えば、担当者名のファイルを、各担当者のフォルダへ自動で振り分けて移動させることができます。
今回は「各担当者名のファイルを各担当者名のフォルダへ自動で振り分けて移動するマクロを作る方法」を紹介します。
各担当者名のファイルを各担当者名のフォルダへ自動で振り分けて移動するマクロを作る方法
各担当者名のファイルを各担当者名のフォルダへ自動で振り分けて移動するマクロを作る方法です。
ファイル名の先頭に、担当者「A」や「B」の名前がついていて、「A」フォルダ、「B」フォルダへ移動させるのを例に紹介します。
後半では、日本語の担当者名で自動振り分けした実例を紹介します。
マクロを作るときは、「開発」タブを使います。
開発タブが出ていない方は、下のリンクで出し方を紹介していますので、まずは準備をお願いします。
→エクセルで開発タブを表示する方法
１．「開発」タブをクリック →「挿入」をクリック →「ボタン」をクリック
２．「新規作成」をクリック
３．コード入力画面が開く
４．コードを入力
コードを入力します。
赤枠部のコードです。
Option Explicit
' フォルダパスの設定（ユーザー名を適宜変更してください）
Const SourceFolder As String = "C:\Users\*****\Desktop\CC"
Const FolderA As String = "C:\Users\*****\Desktop\A"
Const FolderB As String = "C:\Users\*****\Desktop\B"
Sub ボタン1_Click()
Dim FileName As String
Dim SourcePath As String
Dim DestinationPath As String
Dim FirstChar As String
' ソースフォルダ内のファイル取得
FileName = Dir(SourceFolder & "\*.*")
Do While FileName <> ""
SourcePath = SourceFolder & "\" & FileName
FirstChar = UCase(Left(FileName, 1)) ' 先頭の1文字を取得（大文字変換）
' ファイル名の先頭文字で移動先を決定
Select Case FirstChar
Case "A"
DestinationPath = FolderA & "\" & FileName
Case "B"
DestinationPath = FolderB & "\" & FileName
Case Else
' 「A」「B」以外のファイルはスキップ
GoTo SkipFile
End Select
' ファイルを移動
FileCopy SourcePath, DestinationPath
Kill SourcePath
SkipFile:
' 次のファイルを取得
FileName = Dir()
Loop
MsgBox "ファイルの移動が完了しました！", vbInformation
End Sub
※*****のところは、適切なパスを入れて下さい。
５．ボタンができた →ボタンを押す
ボタンができたら、ボタンを押しましょう。
６．ファイルが自動で振り分けされて移動した
自動でファイルが移動しました。
Aから始まるファイルは、フォルダAへ。
Bから始まるファイルは、フォルダBへ、自動で移動しました。
Cから始まるファイルは、移動しないままになります。
７．ファイル名を変えてやってみる
ちょっとファイル名を変えて、もう一度やってみました。
ボタンを押します。
同じようにファイル移動ができました。
実際の使い方の例：日本語の担当者名で自動振り分けする
次は、担当者が日本人だとして、日本語の担当者名で自動振り分けしてみます。
「まとめ」フォルダに、各担当者名のついたファイルが入っています。
石破、岸田、菅、安倍、小笠原という担当者が5人いて、小笠原以外のファイルを、各担当者のフォルダに自動で振り分けします。
１．コードを入力
２．ボタンを押す →自動振り分けできた
コードを入力したらボタンを押します。
・・・自動振り分けできました！
これならファイルの振り分けも楽チンですね！
まとめ
各担当者名のファイルを、各担当者名のフォルダへ自動で振り分けて移動するマクロを作る方法です。
１．「開発」タブをクリック →「挿入」をクリック →「ボタン」をクリック
２．新規作成をクリック
３．コードを入れる画面が出る
４．コードを入力
５．ボタンができた →ボタンを押す
６．ファイルが自動で振り分けされて移動した
これで振り分けは面倒でなくなりましたね！
最後に、2個目に紹介した赤枠部のコードです。
Option Explicit
' フォルダパスの設定（ユーザー名を適宜変更してください）
Const SourceFolder As String = "C:\Users\*****\Desktop\まとめ"
Const FolderIshiba As String = "C:\Users\*****\Desktop\石破"
Const FolderKishida As String = "C:\Users\*****\Desktop\岸田"
Const FolderSuga As String = "C:\Users\*****\Desktop\菅"
Const FolderAbe As String = "C:\Users\*****\Desktop\安倍"
Sub ボタン1_Click()
Dim FileName As String
Dim SourcePath As String
Dim DestinationPath As String
Dim FirstWord As String
' ソースフォルダ内のファイル取得
FileName = Dir(SourceFolder & "\*.*")
Do While FileName <> ""
SourcePath = SourceFolder & "\" & FileName
' 全角スペースを半角スペースに統一
FileName = Replace(FileName, " ", " ")
' 最初の単語（姓）を取得
FirstWord = Split(FileName, " ")(0) ' 半角スペースで区切って最初の要素を取得
' デバッグメッセージ（実行時に確認用）
Debug.Print "処理中のファイル: " & FileName & " - 先頭の単語: " & FirstWord
' ファイル名の先頭文字で移動先を決定
Select Case FirstWord
Case "石破"
DestinationPath = FolderIshiba & "\" & FileName
Case "岸田"
DestinationPath = FolderKishida & "\" & FileName
Case "菅"
DestinationPath = FolderSuga & "\" & FileName
Case "安倍"
DestinationPath = FolderAbe & "\" & FileName
Case Else
' 指定外のファイルはスキップ
GoTo SkipFile
End Select
' ファイルの移動（コピーして元を削除）
FileCopy SourcePath, DestinationPath
Kill SourcePath
SkipFile:
' 次のファイルを取得
FileName = Dir()
Loop
MsgBox "ファイルの移動が完了しました！", vbInformation
End Sub
※*****のところは適切なパスを入れて下さい。
コメント