Ранее я задавал похожий вопрос, и я получил потрясающую помощь от @SJR. Код работал как задумано, но некоторые атрибуты изменились. Как изменить макрос, предоставленный SJR, для работы с этим типом данных. 
При запуске его макрос пропускает много данных. Еще раз спасибо за помощь и вклад. : D
Это макрос SJR для справки.
Sub Step1()
Dim nSpec As Long, nLoc As Long, i As Long, vSpec(), j As Long, k As Long, wsOut As Worksheet, r As Range
nLoc = Worksheets.Count 'number of locations
Set r = Worksheets(1).Range("A3")
Do Until IsEmpty(r)
i = i + 1
ReDim Preserve vSpec(1 To i)
vSpec(i) = r.Value
Set r = r.Offset(11)
Loop
nSpec = UBound(vSpec) 'number of species
Set wsOut = Worksheets.Add(after:=Worksheets(Worksheets.Count)) 'add results sheet
wsOut.Name = "Results"
For i = 1 To nLoc 'headings for results sheet
With Worksheets(i) 'for each location
For j = 1 To nSpec 'for each species
wsOut.Cells(1, (j - 1) * (nLoc + 1) + 1).Value = vSpec(j) 'species heading
wsOut.Cells(2, (j - 1) * (nLoc + 1) + i).Value = .Name 'location heading
Set r = .Range("B4").Offset((j - 1) * 11).Resize(10) 'assumes B4 is top left cell of data
Do Until IsEmpty(r(1))
wsOut.Cells(Rows.Count, (j - 1) * (nLoc + 1) + i).End(xlUp)(2).Resize(10).Value = r.Value 'transfer data
k = k + 1 'move to next column
Set r = .Range("B4").Offset((j - 1) * 11, k).Resize(10)
Loop
k = 0
Next j
End With
Next i
End Sub
