ExcelVBA_tsuichi_work

要件定義

複製の作成:

・各 .xlsx ファイルを処理する前に、VBA実行ファイルを複製します。複製ファイルは、元のVBAファイルのコピーとして、新しい名前で保存されます。
・複製ファイルの名前は「実行後_」＋ .xlsx ファイル名（拡張子除く）＋ .xlsm です。

データのコピペ処理:

・複製ファイルが作成された後、その複製ファイルに対して処理を行います。
・各 .xlsx ファイルの「sheet1」のデータを複製ファイルの指定されたシートにコピーします。
　条件分岐:
　.xlsx ファイル名に「店舗」が含まれている場合: 複製ファイルの「貼付_店舗」シートにコピー。
　.xlsx ファイル名に「店舗」が含まれていない場合: 複製ファイルの「貼付_本社」シートにコピー。

保存:

・データ処理が完了した後、複製ファイルを保存します。保存するファイル名は、「実行後_」＋ .xlsx ファイル名（拡張子除く）＋ .xlsm です。

次のファイル処理:

・次の .xlsx ファイルに対しても、同様にVBA実行ファイルを複製し、処理を行います。

コード

MainProcess ファイルを開くループ処理

Sub MainProcess()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim newFileName As String
    Dim newWorkbook As Workbook
    
    ' VBAが実行されるフォルダを取得
    folderPath = ThisWorkbook.Path & "\"
    
    ' フォルダ内の最初の .xlsx ファイルを取得
    fileName = Dir(folderPath & "*.xlsx")
    
    ' すべての .xlsx ファイルを処理するループ
    Do While fileName <> ""
        
        ' VBAファイルを複製して新しいファイルを作成
        newFileName = folderPath & "実行後_" & Left(fileName, InStrRev(fileName, ".") - 1) & ".xlsm"
        ThisWorkbook.SaveCopyAs newFileName
        
        ' 新しく保存されたVBAファイルを開く
        Set newWorkbook = Workbooks.Open(newFileName)
        
        ' 現在の .xlsx ファイルを開く
        Set wb = Workbooks.Open(folderPath & fileName)
        
        ' コピペ処理を実行★★★★★★★★★★★★★★★★★★★★★
        
        Call CopyDataToSheetWithCondition(newWorkbook, wb, fileName)
        
        '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
        
        ' 開いた .xlsx ファイルを閉じる
        wb.Close False
        
        ' 新しく保存されたVBAファイルを保存
        newWorkbook.Save
        
        ' 新しく保存されたVBAファイルを閉じる
        newWorkbook.Close
        
        ' 次のファイルを取得
        fileName = Dir
    Loop
    
    ' 終了メッセージ
    MsgBox "全てのファイルが処理されました！"
End Sub

コピー処理

Sub CopyDataToSheetWithCondition(targetWorkbook As Workbook, sourceWorkbook As Workbook, fileName As String)
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    Dim targetSheetName As String
    
    ' コピー元のシート
    Set sourceSheet = sourceWorkbook.Sheets("sheet1")
    
    ' 「店舗」がファイル名に含まれているかをチェックして、適切なシート名を設定
    If InStr(fileName, "店舗") > 0 Then
        targetSheetName = "貼付_店舗"
    Else
        targetSheetName = "貼付_本社"
    End If
    
    ' 以下にコピペ処理を実行★★★★★★★★★★★★★★★★★★★★★
       
    '★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★

End Sub