私は以前仕事で、毎日のようにあるファイルを10~30個くらいコピーを作って、ファイル名の末尾に番号をつける作業をしていました。
Ctrl + C、Ctrl + Vで複製してF2でファイル名選択して名前変更、としてると時間がかかってしまいますし、嫌気も感じてしまいます。
そこでマクロを作って自動化しようと思ったのです。
マクロを使うようになってからはもちろん仕事が速くなりました。
マクロが自動で判断して作業をするため、私は脳で判断をする必要が無くなり、無駄に労力を使わない分疲れも感じずに次の仕事に移れました。
自分の判断の意思決定、作業のほとんど全てをマクロに委ねることができました。
コードを下に載せておきますので参考にしてみて下さい。
Microsoft Office 365 Solo (最新 1年更新版)|オンラインコード版|Win/Mac/iPad対応
・コード
※ファイルを大量にコピーしすぎないようにプログラムが安全かしっかりと確認してから実行してください。
コピー元ファイルはコピーして良いファイルかどうかをしっかりと確認してください。
コードを修正して使用する場合も十分注意してください。
ファイルコピーのところで無限ループになってコピーを無限に増やすことになった場合、PCがどうなってしまうかわかりません。その場合はすぐに強制終了したほうがいいでしょう。
Dim PATHNAME
Dim FILENUM As Integer
Dim EXTE As String
Dim I As Integer
' 増やしたいファイルの数量をFILENUMに入れる
FILENUM = Cells(6, 2).Value ’B6セルをファイル数入力欄にしている
If FILENUM > 30 Then ’コピーしすぎるとダメなので数量制限。30超えたらEXIT
MsgBox "ファイル数が多すぎます。"
Exit Sub
Else: End If
’コピー元ファイル選択
Set xlAPP = Application
PATHNAME = xlAPP.GetOpenFilename(FileFilter:=cnsFILTER, Title:=cnsTITLE)
'ファイル拡張子
EXTE = Right(PATHNAME, 4) 'ファイル拡張子取得 右からドットまで
’ファイル名番号付け＆コピー 'コピー元ファイルと同じpathにコピーされる
For I = 2 To FILENUM + 1
FileCopy PATHNAME, Left(PATHNAME, Len(PATHNAME) - 4) & I & EXTE
Next
Dim FPath As String, FileName As String, pNum As Long
pNum = InStrRev(PATHNAME, "\") ’左から\までの数
FPath = Left(PATHNAME, pNum) ’path取得
’エクスプローラを開いてコピー先確認
Shell "C:\Windows\Explorer.exe " & FPath, vbNormalFocus