読込、書き込み切り替え

移動

VLookUp

フォルダ中のファイル名をシートにすべて書き出す

ファイル名の書き換えリネーム

'ファイル名の書出し

Dim フォルダ As String                          'フォルダ名
Dim 拡張子 As String                            'ファイルタイプ（拡張子）
Dim 記入シート As String                        'ファイル名を記入するシート名
Dim パス As String                              'パス
Dim ファイル名 As String                        'ファイル名の取り出しエリア
Dim 貼付行 As Integer                           '貼付行ポインタ
'-----------------------------------------------------------------------------------------
'シート名⇒ファイル一覧　

A2⇒フルパス入力　

A5⇒*.xlsなど　拡張子入れる

C1⇒=IF($E1="","",CONCATENATE($E1,$D$1))　⇒B列に行を合わせる

D1⇒=RIGHTB(A5,4)
'E1⇒新ファイル名を入力する

'-------------------------------------------------------------------------------------------------

Sub フォルダ中のファイル名をシートに書く()
    フォルダ = Cells(2, 1).Value   
    拡張子 = Cells(5, 1)
    記入シート = "ファイル一覧"                 'ファイル名の記入用シートを指定する
     Sheets(記入シート).Activate                 'ファイル名を記入用シートをアクティブにする
     Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents                               'すべてクリア
        Range("C1").Select
    パス = フォルダ & "\"
    ファイル名 = Dir(パス & 拡張子)            '指定された拡張子のファイル名を取り出す
    貼付行 = 0                                 '貼付行ポインタを初期化する
    Do While ファイル名 <> ""                   '取り出したファイル名がヌルでなければ
        貼付行 = 貼付行 + 1                     '貼付行ポインタを上げる
        Cells(貼付行, 2).Value = ファイル名     'セルにファイル名を記入する
        ファイル名 = Dir()                      '次のファイル名を取り出す
    Loop                                        '繰り返し処理

   
End Sub

'-----------------------------------------------------------------------

'ファイル名の書き換えリネーム

 Sub リネーム()

Dim i As Long
Dim NEWファイル As String
Dim OLDファイル As String
Dim パス As String
   

For i = 1 To Range("B65536").End(xlUp).Row
    パス = Cells(2, 1).Value & "\"
  OLDファイル = パス & Cells(i, 2).Value
  NEWファイル = パス & Cells(i, 3).Value
    If Dir(OLDファイル) <> "" Then
        Name OLDファイル As NEWファイル
       
    End If

Next i
End Sub