I looked all over to find a pre-made solution to modify ranges in formulas so I could import worksheets into a new work book and combining the pages into one sheet.
managed to make something that works well hope it helps you.
Sub Offset_Ranges_From_Formula(rng As Range, RowOffset As Integer, ColumnOffset As Integer)
Dim arr() As String, arr1() As String, arr2() As String, arr3() As String, cellValue As String, NewCellValue As String
ReDim arr(0): ReDim arr1(0)
For Each rCell In rng
cellValue = rCell.Formula
For s = 2 To Len(cellValue)
Debug.Print Mid(cellValue, s, 1)
If s < Len(cellValue) Then
If Is_Range(Mid(cellValue, s, 4)) Then
If arr(UBound(arr)) <> "" Then ReDim Preserve arr(UBound(arr) + 1): If arr1(UBound(arr1)) <> "" Then ReDim Preserve arr1(UBound(arr1) + 1)
arr(UBound(arr)) = Mid(cellValue, s, 4)
If InStr("", "$") = 1 And InStr(2, "", "$") = 3 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(True, True)
Else
If InStr("", "$") = 1 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(True, False)
Else
If InStr("", "$") = 2 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(False, True)
Else
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 4)).Offset(RowOffset, ColumnOffset).Address(False, False)
End If
End If
End If
Else
If Is_Range(Mid(cellValue, s, 3)) Then
If arr(UBound(arr)) <> "" Then ReDim Preserve arr(UBound(arr) + 1): If arr1(UBound(arr1)) <> "" Then ReDim Preserve arr1(UBound(arr1) + 1)
arr(UBound(arr)) = Mid(cellValue, s, 3)
If InStr("", "$") = 0 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 3)).Offset(RowOffset, ColumnOffset).Address(False, False)
Else
If InStr("", "$") = 1 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 3)).Offset(RowOffset, ColumnOffset).Address(True, False)
Else
If InStr("", "$") = 2 Then
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 3)).Offset(RowOffset, ColumnOffset).Address(False, True)
End If
End If
End If
Else
If Is_Range(Mid(cellValue, s, 2)) Then
If arr(UBound(arr)) <> "" Then ReDim Preserve arr(UBound(arr) + 1): If arr1(UBound(arr1)) <> "" Then ReDim Preserve arr1(UBound(arr1) + 1)
arr(UBound(arr)) = Mid(cellValue, s, 2)
arr1(UBound(arr1)) = Range(Mid(cellValue, s, 2)).Offset(RowOffset, ColumnOffset).Address(False, False)
End If
End If
End If
End If
Next
For i = LBound(arr) To UBound(arr)
cellValue = Replace(cellValue, arr(i), "[SPLIT_FORMULA]")
Next
arr2 = Split(cellValue, "[SPLIT_FORMULA]")
ReDim arr3(UBound(arr1) + UBound(arr2) + 2)
Odd = 0
Even = 0
For i = 1 To UBound(arr3) + 2
If Application.IsEven(i) Then
If UBound(arr1) >= Even Then
arr3(i - 1) = arr1(Even)
Even = Even + 1
End If
Else
If UBound(arr2) >= Odd Then
arr3(i - 1) = arr2(Odd)
Odd = Odd + 1
End If
End If
Next
NewCellValue = Join(arr3, "")
rCell.Formula = NewCellValue
Next rCell
End Sub