Sub TransferData()
Dim ws As Worksheet
Dim newWorkbook As Workbook
Dim newRow As Integer
Dim cellValueE12 As Variant, cellValueE13 As Variant
' 新規ワークブックを作成
Set newWorkbook = Workbooks.Add
newRow = 1
' ThisWorkbookの各シートをループ
For Each ws In ThisWorkbook.Sheets
' E12とE13のセル値を取得
cellValueE12 = ws.Range("E12").Value
cellValueE13 = ws.Range("E13").Value
' 新規ワークブックにデータを転記
With newWorkbook.Sheets(1)
.Cells(newRow, 1).Value = ws.Name
.Cells(newRow, 2).Value = cellValueE12
.Cells(newRow, 3).Value = cellValueE13
End With
newRow = newRow + 1
Next ws
End Sub
