Properly looping through non-contiguous ranges?

I have a few non-contiguous ranges that may vary in size each time it is run. I would like to take each of the ranges and copy and paste them onto their own individual worksheets (one range per sheet).

My code currently works for the first range and sheet. After the second sheet is created, the ranges are highlighted, but the first range is again copied and pasted onto the second sheet, instead of the corresponding second range. Then, the third sheet is created, but again, only the first range is copied and pasted onto this sheet. I know something is wrong with my looping, but I can't figure out where.

I have exhausted all of my resources. I just can't figure out why the loop isn't getting to the other 2 ranges.

'Get current sheet name
Dim activeSheetName As String
activeSheetName = ActiveSheet.Name

'Create a new sheet to reformat existing data
Dim newSheetName As String
newSheetName = (activeSheetName + "_Data")

Dim filterRange As range
Dim areasCount As Integer
For Each a In filterRange.Areas
    Sheets(newSheetName).Select
    filterRange.Select
    range(Selection, Selection.End(xlToRight)).Select
    areasCount = Selection.Areas.Count
    With a
        For i = 2 To areasCount + 1
            Selection.Copy
            With Sheets.Add(After:=Sheets(Sheets.Count))
                .Name = a.Cells(1, 1).Value
                .range("A1").Value = a.Offset(, 1)
                range("A50").Select
                Selection.PasteSpecial paste:=xlPasteAll, Operation:=xlNone, _
                    SkipBlanks:= False, Transpose:=False
                Application.CutCopyMode = False
            End With
        Next i
    End With
Next a

I have tried to incorporate the following code I found in a book, but no such luck.

Dim SelAreas() As range
Dim pasteRange As range
Dim upperLeft As range
Dim numAreas As Long, i As Long
Dim topRow As Long, leftCol As Long
Dim rowOffset As Long, colOffset As Long

If TypeName(Selection) <> "Range" Then Exit Function

numAreas = Selection.Areas.Count
ReDim SelAreas(1 To numAreas)

For i = 1 To numAreas
    Set SelAreas(i) = Selection.Areas(i)
Next

topRow = ActiveSheet.Rows.Count
leftCol = ActiveSheet.Columns.Count

For i = 1 To numAreas
    If SelAreas(i).Row < topRow Then topRow = SelAreas(i).Row
    If SelAreas(i).Column < leftCol Then leftCol = SelAreas(i).Column
Next

Set upperLeft = Cells(topRow, leftCol)

On Error Resume Next
Set pasteRange = range("A50")
On Error GoTo 0

If TypeName(pasteRange) <> "Range" Then Exit Function

Set pasteRange = pasteRange.range("A1")

For i = 1 To numAreas
    rowOffset = SelAreas(i).Row - topRow
    colOffset = SelAreas(i).Column - leftCol
    SelAreas(i).Copy
    range("A1").Value = pasteRange.Offset(rowOffset, colOffset)
Next i