how to increment the cell value horizontally? in VBA macro - excel

Question

I'm writing VBA program in powerpoint
The flow of program: VBA powerpoint macro have to open the excel file and copy and replace cell content to the specific shape in a specific slide.
Here the excel file has 21 columns. I have to copy and replace cell data to slide shape in slide #8. How to increment the cell value horizontally? Like a1 to b1 till 21 cells and repeat the same from beginning
here the code
Sub xltoppt()
Dim xlApp As Object
Dim xlWorkBook As Object
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWorkBook = xlApp.Workbooks.Open("C:\Users\\Desktop\test.xls", True, False)
Set xlApp = Nothing
Set xlWorkBook = Nothing
Dim SheetName As String
Dim TestRange As Range
Dim TestSheet As Worksheet
Dim PasteRange As Boolean
Dim RangePasteType As String
Dim RangeName As String
Dim AddSlidesToEnd As Boolean
Dim shts As Worksheet
Dim sld As Slide
Dim grpItem As Shape
Dim shp As Shape
Dim i As Long
Dim j As Long
SheetName = ActiveSheet.Name
'Setting PasteRange to True means that Chart Option will not be used
PasteRange = True
RangeName = ("B1:B1") '"MyRange"
RangePasteType = "HTML"
RangeLink = True
PasteChart = False
PasteChartLink = True
ChartNumber = 1
AddSlidesToEnd = True
'Error testing
On Error Resume Next
Set TestSheet = Sheets(SheetName)
Set TestRange = Sheets(SheetName).Range(RangeName)
Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber)
On Error GoTo 0
'If TestSheet Is Nothing Then
'MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical
Exit Sub
'End If
'If PasteRange And TestRange Is Nothing Then
MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical
Exit Sub
'End If
'Look for existing instance
'On Error Resume Next
'Set ppApp = GetObject(, "PowerPoint.Application")
'On Error GoTo 0
'Create new instance if no instance exists
''If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
'Add a presentation if none exists
'If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
'Make the instance visible
ppApp.Visible = True
'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
For Each sld In ActivePresentation.Slides
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
shp.TextFrame.TextRange.Text = replace(shp.TextFrame.TextRange.Text, "happy", Worksheets(SheetName).Range(RangeName))
End If
End If
Next shp
Next
End Sub```