ドキュメント自動生成ひな形

作成途中

Option Explicit

Sub すべてのファイルに値を代入()

'FSOを宣言
Dim fso_lord As Object: Set fso_lord = CreateObject("scripting.filesystemobject")
Dim wbPath As Variant
Dim myfiles As Variant
Dim file As Variant

Dim Input_wb As Workbook
Dim Input_LastLline As Long
Dim Output_Path As Variant


Dim mySh As Worksheet

Dim Item1 As String
Dim Filename As String


'pathの設定
wbPath = ThisWorkbook.Path & "\INPUTファイル\"

Set myfiles = fso_lord.getfolder(wbPath).Files
    
For Each file In myfiles
    If Not file.Name Like "~$*" Or file.Name Like ".xlsx" Then
        Call OpenBooks_String(wbPath & file.Name)
        Set Input_wb = ActiveWorkbook
        
        
        Workbooks.Add
        Filename = "成果物1"
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\成果物\" & Filename
        Output_Path = ActiveWorkbook.Name
        
        
        'ブック間のデータのやり取り！
        Workbooks(file.Name).ActiveSheet.Range("A1").Copy Workbooks(Output_Path).Sheets(1).Range("A1")
        
        
'        Workbooks(file.Name).Activate
'        Sheets("INPUT_ITEM").Range("A1").Copy
'
'        Workbooks(Output_Path).Activate
'        Range("A1").PasteSpecial Paste:=xlPasteValues
'
        
        
        
        
        '対象のSheetを探す処理
        For Each mySh In Input_wb.Worksheets
            
            '特定のsheetを処理する
            If mySh.Name = "INPUT_ITEM" Then
                
                Item1 = mySh.Range("A2")
                
                MsgBox mySh.Name
            
            End If
            
        
        Next
        
    
        
        '転記する処理
        Workbooks.Add
        
        
        Call CloseBooks_Sring(file.Name)
    End If
Next


End Sub


Sub OpenBooks_String(ByVal mypath As String)
    
Workbooks.Open mypath
'Range("A1").Value = "自動で開きました。"

End Sub


Sub CloseBooks_Sring(ByVal myName As String)
    
Dim wb As Workbook
Set wb = Workbooks(myName)

wb.Close (True)

End Sub