Selected Answer
Leap
I'm not sure what you're trying to do here but the sheet SavedSpecs is empty (apart from row 1) so your line
a = Sheets("SavedSpecs").Range("a" & Rows.Count).End(xlUp).Resize(, 5).Value
creates an array with just 5 entries (from
SavedSpecs $A$1:$E$1).
Your code then tries to loop through a split range in Cover, copying these values.There are only 5 entries so when i reaches 6, VBA sees an error ("where's the 6th array entry?").
In the attached version of your updated workbook, I see that your data sheet has a strange design (to my mind) so I've taken the simple approach of copying the blocks of data to set destinations in result then using a loop (like yours) to get the "spilt" data into a horizontal format (as your example showed).
REVISION: The macro below is extended to add the data to that existting on the destination sheet result, add item numbers in column A, add borders to the copied values plus give a message when that's done. It does NOT delete the entries in the source sheet data (I leave that for you to do that, once tested and if needed). Here is the revised code, with comments (and recent changed parts indicated in bold):
Sub CopyData()
'
' Macro to copy split ranges
'
'
Dim WsSrc As Worksheet, WsDest As Worksheet
Dim RwUp As Integer, RwLow As Integer, RwDest As Integer, i As Integer
Application.ScreenUpdating = False
Set WsSrc = Worksheets("data")
Set WsDest = Worksheets("result")
'find next destination data row
RwDest = Range("A" & Rows.Count).End(xlUp).Row + 1
RwUp = WsSrc.Range("A17").End(xlUp).Row 'find last row used in upper part of WsSrc
RwLow = WsSrc.Range("A32").End(xlUp).Row 'find last row used in lower part of WsSrc
'copy/ map blocks of data:
WsSrc.Range("A8:E" & RwUp).Copy
WsDest.Range("B" & RwDest).PasteSpecial Paste:=xlPasteValues
WsSrc.Range("A21:A" & RwLow).Copy
WsDest.Range("G" & RwDest).PasteSpecial Paste:=xlPasteValues
WsSrc.Range("E21:F" & RwLow).Copy
WsDest.Range("H" & RwDest).PasteSpecial Paste:=xlPasteValues
' Get non-contiguous data and copy values horizontally
For Each Splt In WsSrc.Range("B37, E36, C18, C19, D4, D5, H4")
'place value horizontally
WsDest.Range("J" & RwDest).Offset(0, i).Value = Splt.Value
i = i + 1
Next Splt
' add item no. in column A of Destination (partly unpopulated to start so count rows now in B)
For i = RwDest To WsDest.Range("B" & Rows.Count).End(xlUp).Row
WsDest.Range("A" & i).Value = i + 1 - RwDest
Next i
' add borders to used range...
With WsDest.UsedRange.Borders
.LineStyle = xlContinuous
.ColorIndex = 0
.Weight = xlThin
End With
WsDest.Range("A" & i).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
i = MsgBox("Data transferred", vbOKOnly)
End Sub
Hope this works for you.