さえはん

さえはん

Option Explicit

Dim ref As String

Dim myDir, myName, リスト, 原本 As String

Sub comm()
'=YEAR(TODAY())&IF(MONTH(TODAY())<10,"0"&MONTH(TODAY()),MONTH(TODAY()))&IF(DAY(TODAY())<10,"0"&DAY(TODAY()),DAY(TODAY()))
'=IF(INDIRECT("["&$B$5&"]sheet!A2")="","",INDIRECT("["&$B$5&"]sheet!A2"))
  ref = "ref"
  myName = ActiveWorkbook.Name
  myDir = ActiveWorkbook.Path
  Workbooks(myName).Sheets(ref).Range("b4:b5").Clear
  Workbooks(myName).Sheets(ref).Range("b4").Value = myDir
  リスト = Dir(myDir & "\*.csv")
  Workbooks(myName).Sheets(ref).Range("b5").Value = リスト
  原本 = Workbooks(myName).Sheets(ref).Range("b3").Value
  Workbooks.Open myDir & "\" & リスト
  
  
  
End Sub


Sub test()
  Call comm
  Dim i As Integer
  Dim 今日, 宛名, 管理番号, 作成ファイル名, 作業者名 As String
  今日 = Workbooks(myName).Worksheets(ref).Range("b2").Value
  作業者名 = Workbooks(myName).Worksheets(ref).Range("b1").Value

  For i = 12 To 15
    宛名 = Workbooks(myName).Worksheets(ref).Range("b" & i).Value
    管理番号 = Workbooks(myName).Worksheets(ref).Range("c" & i).Value
    
    If (宛名 = "") Then
      Exit For
    End If

    '原本からファイル作成
    Workbooks.Open myDir & "\" & 原本
    Workbooks(原本).Worksheets(1).Range("a5").Value = 宛名
    'Workbooks(原本).Worksheets(1).Range("a5").Value = 氏名

    作成ファイル名 = 今日 & "-" & 管理番号 & "_" & 作業者名 & ".xlsx"
    Workbooks(原本).SaveAs Filename:=myDir & "\" & 作成ファイル名
    Workbooks(作成ファイル名).Close

  Next i

End Sub