仕事メモ

Sub 集計マクロ()
Application.ScreenUpdating = False
Dim i As Long, ID As Long, fname As String, bookname As String, sumifolda As String, motofaile As String

Dim m As Worksheet
fname = "一覧表.xlsx"
sumifolda = "処理済"
motofaile = ThisWorkbook.Path & "\" & "コピー元ファイル.xlsx"

If Dir(ThisWorkbook.Path & "\" & fname) <> "" Then
    Workbooks.Open Filename:=ThisWorkbook.Path & "\" & fname
    Debug.Print fname
    Set m = Sheets("マスタ一覧")
        For i = 3 To m.Cells(Rows.Count, 1).End(xlUp).Row
            ID = Cells(i, 1).Value
            bookname = Cells(i, 2).Value
            Workbooks.Open Filename:=motofaile
            ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sumifolda & "\" & ID & bookname & ".xlsx"
            ActiveWorkbook.Close savechanges:=True
        Next
End If

End Sub

アンケート集計（同一フォルダのエクセルを開いてアンケート一覧へ転記処理）

Sub アンケート集計()
Dim フォルダー名 As String
Dim ファイル名 As String
Dim i
i = 5
Dim 氏名
Dim 回答1
Dim 回答2
Dim 回答3

フォルダー名 = ThisWorkbook.path & "\"
ファイル名 = Dir(フォルダー名 & "*.xlsx")
With ThisWorkbook.Sheets("アンケート一覧")
   Range("C4").CurrentRegion.Offset(1, 0).ClearContents
End With


Do While ファイル名 <> ""
    Workbooks.Open (フォルダー名 & ファイル名)
    With Sheets("アンケート")
        氏名 = Range("B3")
        回答1 = Range("B5")
        回答2 = Range("B6")
        回答3 = Range("B6")
    End With
    With ThisWorkbook.Sheets("アンケート一覧")
        .Cells(i, "C") = 氏名
        .Cells(i, "D") = 回答1
        .Cells(i, "E") = 回答2
        .Cells(i, "F") = 回答3
    End With
 　ActiveWorkbook.Close (フォルダー名 & ファイル名)

    i = i + 1
        ファイル名 = Dir()
Loop
End Sub