With some help, we've gotten REAL close!
The first issue is fixing the .Offset code so that the copy range ("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row) is "inserted" into the very next row (A:P) below the initial selected row, rather than (A2:P2) where it goes now. < This location seems to change if there are any blank rows near the top of the worksheet fwiw.
Then I need some sort of loop that runs the macro until there's no more data in columns outside column P.
Sub FixAllOnLine1OneRowAtATimeInsertToNextRow() Dim ws As Worksheet Dim lNextRow As Long Application.ScreenUpdating = False Set ws = ActiveSheet ws.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy 'Copy the row of the selected cell from Q:AF ws.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select 'Select the cells you have just copied. Not needed ws.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).Insert xlShiftDown ' Paste the copied values in to column "A" on next row 'OR 'lNextRow = ws.Range("A" & Rows.count).End(xlUp).Row + 1 'Get Next Row number 'Range("A" & lNextRow).PasteSpecial xlPasteValues Application.CutCopyMode = False Range("Q:AF").Delete Shift:=xlToLeft 'Columns("Q:AF").Select 'Selection.Delete Shift:=xlToLeft Application.ScreenUpdating = True ActiveCell.Offset(RowOffset:=-1, columnOffset:=0).Activate 'Added to move active cell up one row to single click to run again. End Sub
Here's a quick example for clarification.
1) Highlight, say, row 10 that includes cell ranges A10:P10, Q10:AF10, AG10:AV10, etc.
2) Copy the cell range Q10:AF10
3) Insert contents into cell range A11:P11
4) Delete columns ("Q:AF")
5) See code 'Added to move active cell up one row...
6) So I can run a loop until there's no more data outside of column P. (Stop when there's data only in columns A to P.)