SOLVED

Need a formula or Macro

Copper Contributor

Hello, I need a way to shift data within multiple columns and rows. To go from looking like (columns A-E)  to looking like (Columns I-M) below.

Inkedshift data_LI.jpg

2 Replies
best response confirmed by aangus07 (Copper Contributor)
Solution

@aangus07 

Here is a macro. You can change the constants at the beginning if desired.

 

Sub ShiftData()
    Const FirstRow = 10
    Const StartCol1 = 1
    Const StartCol2 = 9
    Const NumCols = 5
    Dim SourceCol As Long
    Dim TargetRow As Long
    Dim TargetCol As Long
    Dim LastRow As Long
    Dim NumRows As Long
    Dim i As Long
    Application.ScreenUpdating = False
    TargetRow = FirstRow
    For i = 1 To NumCols
        SourceCol = StartCol1 + i - 1
        TargetCol = StartCol2 + i - 1
        LastRow = Cells(Rows.Count, SourceCol).End(xlUp).Row
        NumRows = LastRow - FirstRow + 1
        Cells(TargetRow, TargetCol).Resize(NumRows).Value = _
            Cells(FirstRow, SourceCol).Resize(NumRows).Value
        TargetRow = TargetRow + NumRows
    Next i
    Application.ScreenUpdating = True
End Sub

@Hans Vogelaar 

Awesome! works well, thank you very much!

1 best response

Accepted Solutions
best response confirmed by aangus07 (Copper Contributor)
Solution

@aangus07 

Here is a macro. You can change the constants at the beginning if desired.

 

Sub ShiftData()
    Const FirstRow = 10
    Const StartCol1 = 1
    Const StartCol2 = 9
    Const NumCols = 5
    Dim SourceCol As Long
    Dim TargetRow As Long
    Dim TargetCol As Long
    Dim LastRow As Long
    Dim NumRows As Long
    Dim i As Long
    Application.ScreenUpdating = False
    TargetRow = FirstRow
    For i = 1 To NumCols
        SourceCol = StartCol1 + i - 1
        TargetCol = StartCol2 + i - 1
        LastRow = Cells(Rows.Count, SourceCol).End(xlUp).Row
        NumRows = LastRow - FirstRow + 1
        Cells(TargetRow, TargetCol).Resize(NumRows).Value = _
            Cells(FirstRow, SourceCol).Resize(NumRows).Value
        TargetRow = TargetRow + NumRows
    Next i
    Application.ScreenUpdating = True
End Sub

View solution in original post