【マクロ】【画像あり】ファイル名を別名にて保存。元ファイルはゴミ箱へ移動⇒する方法について

【やりたい事】
４つのファイルを１つ転記するたびに

❶　シート①へ転記した後。ファイル名を変更する

a_20250529123939.csv　⇒　転記済a_20250529123939.csv
※現在は、wb.Close　←コードより抜粋　'csvを閉じる　コピー元ファイルを閉じているだけです


❷　元ファイルはゴミ箱へ移動したい

a_20250529123939.csv⇒ゴミ箱へ移動。※コピー元ファイル

●●●●４回繰り返す●●●●
※ファイルが４個の場合。ファイルは１から４個まで変わります


【マクロ説明】下記画像をご覧ください

以下画像とコードをご覧ください

４つのCSVデータを、別ブックの４つのシートへ１つづつ、順番にコピーするマクロです
※CSVはexcelブックに置き換えて考えて頂いてもOKです。同じです
※４つのCSVデータは、１から４個まで変わります
※CSVデータはエクセルと置き換えてもOKです



【マクロの保存されているファイル】※マクロにて指示するファイル
C:\Users\2020\OneDrive\マクロ\ツール\コントロール.xlsm


【４つのファイル】※コピー元

"C:\Users\user\Documents\web\ダウンロード場所\a_20250529123939.csv"
※シートは１つしかない。名前は不規則

"C:\Users\user\Documents\web\ダウンロード場所\a_20250529123940.csv"
※シートは１つしかない。名前は不規則

"C:\Users\user\Documents\web\ダウンロード場所\a_20250529123941.csv"
※シートは１つしかない。名前は不規則

"C:\Users\user\Documents\web\ダウンロード場所\a_20250529123942.csv"
※シートは１つしかない。名前は不規則


【貼付先】コピー先。下記画像の左上のエクセルファイル
C:\Users\2020\OneDrive\マクロ\ツール\ツール.xlsm

シート①
シート②
シート③
シート④


【ゴミ箱】
C:\Users\2020\OneDrive\マクロ\ツール\ダウンロード場所\ゴミ箱


【コード】本サイト アンサーにてご指南頂きました。動きます

Sub 貼付先ツールへ転記｡1から4個まで()

Const Folder_path As String = "C:\Users\2020\OneDrive\マクロ\ツール\ダウンロード場所"
Dim fname As String

'csv
Dim wb As Workbook

'１個目の、CSVファイル名を取得
fname = Dir(Folder_path & "\*.csv")


'貼付先ツール
Dim filepath1 As String

'貼付先ツール
Dim wb1 As Workbook

'貼付先ツール
Dim ws1 As Worksheet

'貼付先ツール
filepath1 = ThisWorkbook.Worksheets("Sheet1").Cells(1, 1)

'貼付先ツール。既に開いている。重くならないかチェック
Set wb1 = Workbooks.Open(filepath1)


'貼付先ツール
Dim sno As Long: sno = 0

'貼付先ツール
Dim sname As String
'貼付先ツール
Dim name_tbl As Variant
'貼付先ツール
name_tbl = Array("シート①", "シート②", "シート③", "シート④")

'csv
Do While fname <> ""


Set wb = Workbooks.Open(Folder_path & "\" & fname)

sname = name_tbl(sno)

wb.Worksheets(1).Cells(1, 1).CurrentRegion.Copy

wb1.Worksheets(sname).Cells(1, 1).PasteSpecial Paste:=xlPasteValues

'csvを閉じる
wb.Close

sno = sno + 1


'２個目の、CSVファイル名を取得
fname = Dir()

Loop

Worksheets(name_tbl(0)).Activate

Cells(1, 1).Select

End Sub

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2025/06/01 22:27

以下のようにしてください。

「ダウンロード場所」の直下に"ゴミ箱"のフォルダーが作成されている前提です。

Sub 貼付先ツールへ転記｡1から4個まで()

Const Folder_path As String = "C:\Users\2020\OneDrive\マクロ\ツール\ダウンロード場所"
Dim fname As String

'csv
Dim wb As Workbook

'１個目の、CSVファイル名を取得
fname = Dir(Folder_path & "\*.csv")


'貼付先ツール
Dim filepath1 As String

'貼付先ツール
Dim wb1 As Workbook

'貼付先ツール
Dim ws1 As Worksheet

'貼付先ツール
filepath1 = ThisWorkbook.Worksheets("Sheet1").Cells(1, 1)

'貼付先ツール。既に開いている。重くならないかチェック
Set wb1 = Workbooks.Open(filepath1)


'貼付先ツール
Dim sno As Long: sno = 0

'貼付先ツール
Dim sname As String
'貼付先ツール
Dim name_tbl As Variant
'貼付先ツール
name_tbl = Array("シート①", "シート②", "シート③", "シート④")

'csv
Do While fname <> ""


Set wb = Workbooks.Open(Folder_path & "\" & fname)

sname = name_tbl(sno)

wb.Worksheets(1).Cells(1, 1).CurrentRegion.Copy

wb1.Worksheets(sname).Cells(1, 1).PasteSpecial Paste:=xlPasteValues

'csvを閉じる
wb.Close

'ファイル名を変更し、ゴミ箱へ移動する
Dim newPath As String
newPath = Folder_path & "\ゴミ箱\" & "転記済" & fname
Name Folder_path & "\" & fname As newPath

sno = sno + 1


'２個目の、CSVファイル名を取得
fname = Dir()

Loop

Worksheets(name_tbl(0)).Activate

Cells(1, 1).Select

End Sub

-------------------------------------------------
念のためですが、
wb.Worksheets(1).Cells(1, 1).CurrentRegion.Copy
を行うと、データによっては、コピーされないケースがあります。
添付図のようなデータをコピーすると、コピーされるのは緑の部分だけです。（黄色の部分はコピーされません）
このことを承知で使用されるなら特に問題はありませんが、このようなケースがあり得るなら、CurrentRegion.Copyはやめたほうが良いかと思います。

No.1 回答者： fujillin 回答日時： 2025/06/01 19:01

こんばんは

わざわざゴミ箱へ移動しなくても、ファイル名を変えるだけなら、直接 Name ステートメントでできますよ。
ブックを閉じたら、Nameで変更すればよいでしょう。
https://learn.microsoft.com/ja-jp/office/vba/lan …


＞※CSVデータはエクセルと置き換えてもOKです
エクセルデータに変更したい場合は、単純なファイル名変更ではありませんので、
　・開いたブックを新しい名前を付けて保存（Save As）
　・その後、元のcsvファイルを削除（Kill）
という手順にすればよいでしょう。
https://learn.microsoft.com/ja-jp/office/vba/lan …