Sub ExtractData() ' Runs through each of the completed template sheets and copies the data into a flattened table Dim wshTemplate As Worksheet Dim intColumn As Integer intColumn = 4 With ActiveWorkbook.Sheets("Extract data") ' Iterate through sheets in the workbook For Each wshTemplate In ActiveWorkbook.Sheets ' Restrict to sheets representing completed templates If wshTemplate.Name <> "Extract data" And wshTemplate.Name <> "All data transposed" Then Dim intRow As Integer ' Iterate through the field to cell mappings in the 'Extract data' sheet and copy the value into the relevant column For intRow = 2 To 83 .Cells(intRow, intColumn).Value = wshTemplate.Cells(.Cells(intRow, 2), .Cells(intRow, 1)).Value Next intRow intColumn = intColumn + 1 End If Next wshTemplate End With End Sub