Sheet1(Circular)
Sub mergeAP()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "AP").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 42)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeAT()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "AT").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 46)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeAW()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "AW").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 49)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeBA()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "BA").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 53)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeBF()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "BF").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 58)
If .Offset(0, 1) = "" Then
.Offset(s, 4) = .Value
Else
.Offset(s, 4) = .Offset(0, 1).Value
.Offset(s + 1, 4) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sheet2(Hyperbolic)
Sub mergeAX()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "AX").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 50)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeBB()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "BB").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 54)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeBE()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "BE").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 57)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeBI()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "BI").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 61)
If .Offset(0, 1) = "" Then
.Offset(s, 2) = .Value
Else
.Offset(s, 2) = .Offset(0, 1).Value
.Offset(s + 1, 2) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sub mergeBN()
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "BN").End(xlUp).Row
s = 0
For r = 2 To lr
With Cells(r, 66)
If .Offset(0, 1) = "" Then
.Offset(s, 4) = .Value
Else
.Offset(s, 4) = .Offset(0, 1).Value
.Offset(s + 1, 4) = .Value
s = s + 1
End If
End With
Next r
End Sub
Sheet 1 range is $AP:$BG
Sheet 2 range is $AX:$BO
The values in these ranges are given by formulas, and they will be locked for the user. Ideally I don't want to use a button to run the codes, they should trigger automatically.