改め VBAで ユーザーフォームのコンボボックスで選んだファイルを開き（ひな形） これをコピーして新しいファイルを作り コンボボックスの値と名簿.csvから検索した氏名などで名前を付けて保存し 名前がかぶったら（ｎ）として保存

 //不要な箇所は全部消しました

Private Sub CommandButton2_Click()

'請求書の作成

Dim myPath, mySubPath, YearFolder As String

Dim FileName, ListBox1 As String

Dim bk As Workbook

Dim myDay As String

Dim wbNew As String

 

'On Error Resume Next

 '自身以外のworkbooksを閉じる

  For Each bk In Workbooks

    If Not (bk Is ThisWorkbook) Then

      bk.Close savechanges:=False

    End If

  Next

myPath = Left(ThisWorkbook.Path, InStrRev(ThisWorkbook.Path, "\") - 1) & "\"  '親パスのフルパス

'myPath = ThisWorkbook.Path & "\"　'自分自身のフルパス

mySubPath = myPath & "請求書-ひな形" & "\"

FileName = UserForm1.ComboBox3 & ".xls"

If UserForm1.ComboBox3 = "" Then

 MsgBox "様式を選択してください"

 Exit Sub

Else

Workbooks.Open mySubPath & FileName

ActiveWindow.SelectedSheets.Copy

wbNew = ActiveWorkbook.Name

End If

Dim flag As Boolean

 flag = False

Dim trgtFileName As String

trgtFileName = myPath & "\" & "名簿-外注費.csv"

Dim wb As Workbook

For Each wb In Workbooks

    If wb.Name = trgtFileName Then

        flg = True

        Exit For

    End If

Next

If flg = False Then

    Workbooks.Open trgtFileName

End If

Set wb = Nothing

Dim myDayStr, ggg, e, mm, dd As String

Dim myDayLng As Long

myDay = Format(Date, "gggemmdd")

myDayStr = CStr(myDay)

ggg = StrConv(Left(myDay, 2), vbWide)

e = StrConv(Mid(myDay, 3, 1), vbWide)

mm = StrConv(UserForm1.ComboBox2.Value, vbWide)

dd = StrConv(UserForm1.ComboBox4.Value, vbWide)

invoiceday = ggg & "　　　　　　" & e & "年" & "　　　　　　" & mm & "月" & "　　　　　　　" & dd & "日"

Dim LastRow As Integer

Dim MyRange As Range

Dim FirstCell As Range

Dim Str As String

Dim myFind, SavePath, SaveName As String

LastRow = ActiveWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row

SavePath = myPath & "2024-Excel" & "\" & UserForm1.ComboBox2.Value & "月"

SaveName = Format(Date, "yyyy") & "年　" & UserForm1.ComboBox2.Value & "月　" & "請求書　"

myFind = UserForm1.ComboBox3.Value

Set MyRange = ActiveWorkbook.Worksheets(1).Range(Cells(1, 5), Cells(LastRow, 8)).Find(what:=myFind, LookAt:=xlPart)

If MyRange Is Nothing Then

Debug.Print "みつかりません"

Exit Sub

 Else

        Set FirstCell = MyRange

    End If

  Dim TargetFiles As Files

 

    SaveNameP = myPath & Format(Date, "yyyy") & "-Excel" & "\" & UserForm1.ComboBox2.Value & "月"

    Set FSO = New FileSystemObject

    Set TargetFiles = FSO.GetFolder(SaveNameP).Files

    Dim fileSaveName As Variant

    Dim fileSaveName_name As String

    Dim fileSaveName_path As String

    Dim k As Integer

    Do

    

    

    

Peopele = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value

   

    fileSaveName = (SaveNameP & "\" & SaveName & Left(Peopele, 2) & ".xlsx")

   

    If Dir(fileSaveName) <> "" Then

        

        fileSaveName_name = Dir(fileSaveName)

        

        fileSaveName_path = Replace(fileSaveName, fileSaveName_name, "")

        k = 1

        Do While Dir(fileSaveName) <> ""

            fileSaveName = fileSaveName_path & Replace(fileSaveName_name, ".xlsx", "") & "(" & k & ")" & ".xlsx"

            k = k + 1

        Loop

       

   

       

    End If

Workbooks(3).Activate 'ひな形のコピーを作る

 With ActiveWorkbook.Worksheets(1)

         Range("N2").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 4).Value 'T_no

         Range("M4").Value = invoiceday

         Range("O6").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 2).Value 'Adress

         Range("O7").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 3).Value 'tel

         Range("O8").Value = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value 'name

         Peopele = Workbooks("名簿-外注費.csv").Worksheets(1).Cells(MyRange.Row, 1).Value

        End With

 Workbooks(3).SaveAs fileSaveName

        Workbooks("名簿-外注費.csv").Activate

        MyRange.Select

        Set MyRange = Cells.FindNext(MyRange)

    

    

        If FirstCell.Address = MyRange.Address Then Exit Do

    Loop

  For Each bk In Workbooks

    If Not (bk Is ThisWorkbook) Then

      bk.Close savechanges:=False

    End If

  Next

Set bk = Nothing

Set myPath = Nothing

Set mySubPath = Nothing

YearFolder = ""

FileName = ""

 myDay = ""

 wbNew = ""

myDayStr = ""

 ggg = ""

 e = ""

 mm = ""

 dd = ""

 myDay = ""

 myDayStr = ""

 LastRow = 0

Set MyRange = Nothing

Set FirstCell = Nothing

Set myFind = Nothing

SavePath = ""

SaveName = ""

Unload Me

End Sub