(Solved) – Excel VBA code that moves large amounts of data from multiple ranges to columns Part 2


I previously asked a similar question and I got amazing help from @SJR. The code worked as intended, but some attributes have changed. How do i change the macro provided by SJR to work for this type of data. enter image description here When I run his macro is skips a lot of data. Again thank you for the help and contributions. 😀

This is SJR’s macro for reference.

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)
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)
            k = 0
        Next j
    End With
Next i

End Sub

SJR's macro worked on this kind of data sheet

Leave a Reply

Your email address will not be published. Required fields are marked *