Вы можете сделать что-то вроде этого:
Sub DataCopy()
Dim wsSummary As Worksheet, wsSource As Worksheet, wb As Workbook
Dim arrCells, rw As Range, i As Long, rng
Set wb = ActiveWorkbook
Set wsSummary = wb.Sheets("Summary")
Set rw = wsSummary.Rows(2) 'start here
arrCells = Array("C14", "D5", "E14", "F14") 'etc: the cells you want to copy, in order
'loop over all the worksheets
For Each wsSource In wb.Worksheets
'exclude the summary sheet
If wsSource.Name <> wsSummary.Name Then
rw.Cells(1).Value = wsSource.Name 'record the source sheet
'loop over the source cells on the sheet
For i = 0 To UBound(arrCells)
rng = arrCells(i)
'if have a cell address, copy the value (skip a column if blank)
If rng <> "" Then rw.Cells(2 + i).Value = wsSource.Range(rng).Value
Next i
Set rw = rw.Offset(1, 0) 'next summary row
End If
Next wsSource
End Sub