VBA merge cells with loop - vba

Question

I want to merge cells two in columns A and B, for example like bellow, and so as long as I have records, below is my code but does not work and does not merge cells do not know what the problem. thanks
.Range("A5", "A6").Merge
.Range("A7", "A8").Merge
.Range("A9", "A10").Merge
.Range("B5", "B6").Merge
.Range("B7", "B8").Merge
.Range("B9", "B10").Merge
Dim i As Integer
Dim j As Integer
Dim xlMerge As Range
Dim xlMergeJ As Range
For i = 5 To ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row Step 2
Set xlMerge = Range(Cells(i, 1), Cells(i + 1, 1))
With xlMerge
.Merge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
Next i
For j = 5 To ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row Step 2
Set xlMergeJ = Range(Cells(j, 2), Cells(j + 1, 1))
With xlMergeJ
.Merge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
Next j

Answer 1

maybe you're after this:
Option Explicit
Sub main()
Dim i As Long
With ActiveSheet
For i = 5 To .Cells(Rows.count, 1).End(xlUp).row Step 2
With .Cells(i, 1).Resize(2)
.Merge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
With .Cells(i, 2).Resize(2)
.Merge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
Next i
End With
End Sub
or its shorter option:
Sub main()
Dim i As Long
With ActiveSheet
For i = 5 To .Cells(Rows.count, 1).End(xlUp).row Step 2
With .Range(.Cells(i, 1).Resize(2).Address & "," & .Cells(i, 2).Resize(2).Address)
.Merge
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
End With
Next i
End With
End Sub