Sub wb()
Dim writeFile As Workbook
Dim index As Integer
Set writeFile = Workbooks.Open("C:\Users\Administrator\Desktop\123.xlsx")
index = 1
myPath = "C:\Users\Administrator\Desktop\Test"
myfile = Dir(myPath & "*.xlsx")
Do Until Len(myfile) = 0
Dim tempFile As Workbook
Set tempFile = Workbooks.Open(myPath & myfile)
writeFile.Sheets(1).Cells(index, 1).Value = tempFile.Sheets(1).Cells(1, 1).Value
writeFile.Sheets(1).Cells(index, 2).Value = tempFile.Sheets(1).Cells(1, 2).Value
writeFile.Sheets(1).Cells(index, 3).Value = tempFile.Sheets(1).Cells(1, 1).Value * tempFile.Sheets(1).Cells(1, 2).Value
tempFile.Close savechanges:=True
myfile = Dir
index = index + 1
Loop
writeFile.Close savechanges:=True
End Sub
