Changing ranges of code

I would like to change the entire code so each range will include data from column O. I tried to change the ranges below but I am not sure how to edit the entire code. Can anyone help? Thanks

    Const sSOURCE_NAME  As String = "Mkt Open"
    Const sTARGET_NAME  As String = "Tkr Consolidation"
    Const sTOP_CELL     As String = "A2"
    Const sRANGE_1      As String = "J10:J19,O10:O19"
    Const sRANGE_2      As String = "J23:J42,O23:O42"
    Const sRANGE_3      As String = "J50:J59,O50:O59"
    Const sRANGE_4      As String = "J63:J82,O63:O82"
    Const sRANGE_5      As String = "J90: J99,O90:O99"
    Const sRANGE_6      As String = "J103:J122,O103:O122"
    Const sRANGE_7      As String = "J130:J139,O130:O139"
    Const sRANGE_8      As String = "J143:J162,O143:O162"
    Const sRANGE_9     As String = "J170:J179,O170:O179"
    Const sRANGE_10     As String = "J183:J202,O183:O202"
    Const sRANGE_11     As String = "J210:J219,O210:O219"
    Const sRANGE_12     As String = "J223:J242,O223:O242"
    Const sRANGE_13     As String = "J250:J259,O250:O259"
    Const sRANGE_14     As String = "J263:J282,O263:O282"
    Const sRANGE_15     As String = "J290:J299,O290:O299"
    Const sRANGE_16     As String = "J303:J322,O303:O322"
    Const sRANGE_17     As String = "J330:J339,O330:O339"
    Const sRANGE_18     As String = "J343:J362,O343:O362"
    Const sRANGE_19     As String = "J370:J379,O370:O379"
    Const sRANGE_20     As String = "J383:J402,O383:O402"

Entire Code

Sub TickerConsolidationShares()
    Application.ScreenUpdating = False
    
    Const sSOURCE_NAME  As String = "Mkt Open"
    Const sTARGET_NAME  As String = "Tkr Consolidation"
    Const sTOP_CELL     As String = "A2"
    Const sRANGE_1      As String = "V10:V19"
    Const sRANGE_2      As String = "V23:V42"
    Const sRANGE_3      As String = "V50:V59"
    Const sRANGE_4      As String = "V63:V82"
    Const sRANGE_5      As String = "V90:V99"
    Const sRANGE_6      As String = "V103:V122"
    Const sRANGE_7      As String = "V130:V139"
    Const sRANGE_8      As String = "V143:V162"
    Const sRANGE_9      As String = "V170:V179"
    Const sRANGE_10     As String = "V183:V202"
    Const sRANGE_11     As String = "V210:V219"
    Const sRANGE_12     As String = "V223:V242"
    Const sRANGE_13     As String = "V250:V259"
    Const sRANGE_14     As String = "V263:V282"
    Const sRANGE_15     As String = "V290:V299"
    Const sRANGE_16     As String = "V303:V322"
    Const sRANGE_17     As String = "V330:V339"
    Const sRANGE_18     As String = "V343:V362"
    Const sRANGE_19     As String = "V370:V379"
    Const sRANGE_20     As String = "V383:V402"
                                


    Dim vaDataValues    As Variant
    Dim rTargetCells    As Range
    Dim rSourceCells    As Range
    Dim rStartCell      As Range
    Dim sDataValue      As String
    Dim wksSource       As Worksheet
    Dim wksTarget       As Worksheet
    Dim iDataCell       As Integer
    Dim rTopCell        As Range
    Dim vRange          As Variant

    Set wksSource = ThisWorkbook.Sheets(sSOURCE_NAME)
    Set wksTarget = ThisWorkbook.Sheets(sTARGET_NAME)

    Set rTopCell = wksTarget.Range(sTOP_CELL)
    Set rStartCell = rTopCell

'   Copy the three ranges of source data to the target worksheet
    For Each vRange In Array(sRANGE_1, sRANGE_2, sRANGE_3, sRANGE_4, sRANGE_5, sRANGE_6, sRANGE_7, sRANGE_8, sRANGE_9, sRANGE_10, sRANGE_11, sRANGE_12, sRANGE_13, sRANGE_14, sRANGE_15, sRANGE_16, sRANGE_17, sRANGE_18, sRANGE_19, sRANGE_20)

        Set rSourceCells = wksSource.Range(vRange)
        vaDataValues = rSourceCells.Value

        Set rTargetCells = Range(rStartCell, _
                                rStartCell.Offset(rSourceCells.Rows.Count - 1, 0))
        rTargetCells.Cells.Clear
        rTargetCells.Value = vaDataValues

        Set rStartCell = rStartCell.Offset(rSourceCells.Rows.Count, 0)

    Next vRange

    Set rTargetCells = Range(rTopCell, rStartCell.Offset(-1, 0))
    With rTargetCells

'       Sort the newly-copied source data (including blank rows) on the target worksheet
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

'       Remove duplicate values from the sorted list of source data
        sDataValue = .Cells(1, 1).Value
        For iDataCell = 2 To rTargetCells.Cells.Count
            If sDataValue = rTargetCells.Cells(iDataCell, 1).Value Then
                  rTargetCells.Cells(iDataCell, 1).ClearContents
            Else: sDataValue = rTargetCells.Cells(iDataCell, 1).Value
            End If
        Next iDataCell

'       Finally, sort the data list again to remove blank (formerly duplicate) values
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

    End With
    
        Application.ScreenUpdating = True

End Sub

Hi rhudgins
consider.. union eg.

Sub ptest()
Set xItem = Union(Range("A1:A3"), Range("C1:C3"))
For Each eItem In xItem
  Debug.Print eItem.Address
  Next
End Sub

but looking at the sub it maybe better to add two loop to handle the number increase in the ranges and have these two loops run another sub routine.
I'll have a close look tomorrow.

I was thinking along these lines

Option Explicit
    Const sRANGE_1      As String = "J10:J19,O10:O19"
    Const sRANGE_2      As String = "J23:J42,O23:O42"
   
Sub ptest()
Dim Vrange As Variant
Dim Xitem As Variant
Dim rSourceCells As Range
Dim x
 For Each Vrange In Array(sRANGE_1, sRANGE_2)
  Xitem = Split(Vrange, ",")
Set rSourceCells = Union(Range(Xitem(0)), Range(Xitem(1)))


For Each x In rSourceCells ' print to immediate window
  Debug.Print x.Address
Next


Next
End Sub

rhudgins
with limited information about what you are doing ...try using

Sub TickerConsolidationShares()
    Application.ScreenUpdating = False
    
    Const sSOURCE_NAME  As String = "Mkt Open"
    Const sTARGET_NAME  As String = "Tkr Consolidation"
    Const sTOP_CELL     As String = "A2"
    Const sRANGE_1      As String = "J10:J19,O10:O19"
    Const sRANGE_2      As String = "J23:J42,O23:O42"
    Const sRANGE_3      As String = "J50:J59,O50:O59"
    Const sRANGE_4      As String = "J63:J82,O63:O82"
    Const sRANGE_5      As String = "J90: J99,O90:O99"
    Const sRANGE_6      As String = "J103:J122,O103:O122"
    Const sRANGE_7      As String = "J130:J139,O130:O139"
    Const sRANGE_8      As String = "J143:J162,O143:O162"
    Const sRANGE_9     As String = "J170:J179,O170:O179"
    Const sRANGE_10     As String = "J183:J202,O183:O202"
    Const sRANGE_11     As String = "J210:J219,O210:O219"
    Const sRANGE_12     As String = "J223:J242,O223:O242"
    Const sRANGE_13     As String = "J250:J259,O250:O259"
    Const sRANGE_14     As String = "J263:J282,O263:O282"
    Const sRANGE_15     As String = "J290:J299,O290:O299"
    Const sRANGE_16     As String = "J303:J322,O303:O322"
    Const sRANGE_17     As String = "J330:J339,O330:O339"
    Const sRANGE_18     As String = "J343:J362,O343:O362"
    Const sRANGE_19     As String = "J370:J379,O370:O379"
    Const sRANGE_20     As String = "J383:J402,O383:O402"
Entire Code

    Dim vaDataValues    As Variant
    Dim rTargetCells    As Range
    Dim rSourceCells    As Range
    Dim rStartCell      As Range
    Dim sDataValue      As String
    Dim wksSource       As Worksheet
    Dim wksTarget       As Worksheet
    Dim iDataCell       As Integer
    Dim rTopCell        As Range
    Dim vRange          As Variant
 dim  Xitem   As Variant

    Set wksSource = ThisWorkbook.Sheets(sSOURCE_NAME)
    Set wksTarget = ThisWorkbook.Sheets(sTARGET_NAME)

    Set rTopCell = wksTarget.Range(sTOP_CELL)
    Set rStartCell = rTopCell

'   Copy the three ranges of source data to the target worksheet
    For Each vRange In Array(sRANGE_1, sRANGE_2, sRANGE_3, sRANGE_4, sRANGE_5, sRANGE_6, sRANGE_7, sRANGE_8, sRANGE_9, sRANGE_10, sRANGE_11, sRANGE_12, sRANGE_13, sRANGE_14, sRANGE_15, sRANGE_16, sRANGE_17, sRANGE_18, sRANGE_19, sRANGE_20)

 Xitem = Split(Vrange, ",")
Set rSourceCells = Union(Range(Xitem(0)), Range(Xitem(1)))





       ' Set rSourceCells = wksSource.Range(vRange)
        vaDataValues = rSourceCells.Value

        Set rTargetCells = Range(rStartCell, _
                                rStartCell.Offset(rSourceCells.Rows.Count - 1, 0))
        rTargetCells.Cells.Clear
        rTargetCells.Value = vaDataValues

        Set rStartCell = rStartCell.Offset(rSourceCells.Rows.Count, 0)

    Next vRange

    Set rTargetCells = Range(rTopCell, rStartCell.Offset(-1, 0))
    With rTargetCells

'       Sort the newly-copied source data (including blank rows) on the target worksheet
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

'       Remove duplicate values from the sorted list of source data
        sDataValue = .Cells(1, 1).Value
        For iDataCell = 2 To rTargetCells.Cells.Count
            If sDataValue = rTargetCells.Cells(iDataCell, 1).Value Then
                  rTargetCells.Cells(iDataCell, 1).ClearContents
            Else: sDataValue = rTargetCells.Cells(iDataCell, 1).Value
            End If
        Next iDataCell

'       Finally, sort the data list again to remove blank (formerly duplicate) values
        .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo

    End With
    
        Application.ScreenUpdating = True

End Sub

There seems to be a pattern in your ranges.
So no need (even the contrary) do define all those 'constants'.

for j=1 to 20
  range("J10:J19,O10:O19").offset(40*(j-1)\2+iif(j mod2 =0,13,0).copy  .....
next

Hi rhudgins

This is way to complicated for what you need.but if you want to keep the range constants so it eaiser for you to select ranges thats ok

but just to copy the ranges to the target work sheet

    For Each vRange In Array(sRANGE_1, sRANGE_2', sRANGE_3, sRANGE_4, sRANGE_5, sRANGE_6, sRANGE_7, sRANGE_8, sRANGE_9, sRANGE_10, sRANGE_11, sRANGE_12, sRANGE_13, sRANGE_14, sRANGE_15, sRANGE_16, sRANGE_17, sRANGE_18, sRANGE_19, sRANGE_20)

 Xitem = Split(vRange, ",")
 With wksSource
Application.Union(.Range(Xitem(0)), .Range(Xitem(1))).Copy Destination:=wksTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
    Next vRange

you can't copy non-contiguous ranges.

for j=1 to 20
  with range("J10:J19")
    .offset(40*(j-1)\2+iif(j mod2 =0,13,0)).copy  ...
    .offset(40*(j-1)\2+iif(j mod2 =0,13,0),5).copy  ...
  end with 
next

@sbn
you will find

For Each vRange In Array(sRANGE_1, sRANGE_2) '
 Xitem = Split(vRange, ",")
 With wksSource
.Application.Union(.Range(Xitem(0)), .Range(Xitem(1))).Copy Destination:=wksTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
    Next vRange
End Sub

will copy the two ranges

rhudgins

run the code below and it will add the ranges to the first empty cell in target sheet

    Const sTOP_CELL     As String = "A2"
     Const sRANGE_1      As String = "J10:J19,O10:O19"
    Const sRANGE_2      As String = "J23:J42,O23:O42"
                                


    Dim vaDataValues    As Variant
    Dim rTargetCells    As Range
    Dim rSourceCells    As Range
    Dim rStartCell      As Range
    Dim sDataValue      As String
    Dim wksSource       As Worksheet
    Dim wksTarget       As Worksheet
    Dim iDataCell       As Integer
    Dim rTopCell        As Range
    Dim vRange          As Variant

    Set wksSource = ThisWorkbook.Sheets(sSOURCE_NAME)
    Set wksTarget = ThisWorkbook.Sheets(sTARGET_NAME)

    Set rTopCell = wksTarget.Range(sTOP_CELL)
    Set rStartCell = rTopCell

'   Copy the three ranges of source data to the target worksheet
  For Each vRange In Array(sRANGE_1, sRANGE_2) '
 Xitem = Split(vRange, ",")
 With wksSource
.Application.Union(.Range(Xitem(0)), .Range(Xitem(1))).Copy Destination:=wksTarget.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
    Next vRange
End Sub

and we can work from there

@Pike

Ok.
My suggestion is using only very basic high school arithmetic.

Originally Posted by snb

[...]

Please keep in mind that I never give solutions, only suggestions.

[...]

...............................