Excel VBA code that moves large amounts of data from multiple ranges to columns

Question

I am researching bird migration patterns and I am having trouble trying to figure out the best and easiest method of moving data around in excel. I am pretty good at excel, but I am terrible at macros and VBA coding, so I apologize in advance if my thinking of coding this looks completely wrong, and that there is nothing wrong with seeking expert advice. So far, I have used a pivot table to narrow out birds based on species count, location and dates.

After that, I moved the data from the dates per species and stack them from a range to a single column.

I did find a vba code that works (even though the output is actually moving the data sideways from left to right, it still is the same thing “moves B4:P4, B5:P5, B6:P6, etc..”), but this is only a single range at a time:

Sub main()
Dim i As Long
Dim cell As Range

For Each cell In Range("B4:P13")
    Range("S4").Offset(i).Value = cell.Value
    i = i + 1
Next cell
End Sub

My problem is that there are 56 species and 3 locations. So I would need to move the data 168 times, which is ridiculous. After I arrange them, I run a single factor analysis 56 times per species in each of the three locations. If anyone can help, that would be amazing and be very helpful for science.

My idea / hopes and dreams:

If I can repeat the code within the same VBA code module and change the values of the ranges and output locations for each species. All 3 locations have the same general format and location of the ranges (plus minus two extra dates), or if I can set the location to another sheet. Like so…

Sub main()
Dim i As Long
Dim cell As Range

For Each cell In Range("B4:P13")
    Range("S4").Offset(i).Value = cell.Value
    i = i + 1
For Each cell In Range("B15:P24")
    Range("U4").Offset(i).Value = cell.Value
    i = i + 1
For Each cell In Range("B26:P35")
    Range("W4").Offset(i).Value = cell.Value
    i = i + 1
For Each cell In Range("B37:P46")
    Range("Y4").Offset(i).Value = cell.Value
    i = i + 1
etc…
Next cell
End Sub

To look something like this:

Or more preferably this:

Again thank you for the help and contributions. :D

Answer 1

Bit more involved that it seemed at first glance. I've made a few assumptions so might need some tweaking if these are not tenable:

• the starting workbook has only one sheet for each location, i.e. the number of sheets equals the number of locations
• data starts in B4 on each sheet (and species names in A3, A14 etc)
• each location sheet has the same number of species

Do use more meaningful procedure and variable names for your actual code.

Sub x()

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