Need help looping this Macro process vs a one off

[wittonlin]

This Macro is used to cut, insert and delete a cell range section of a workbook.

The problem I was trying to solve and gave up with the lack of response in another thread is why copying multiple non-adjacent rows to the MS clipboard often loses their row line-breaks when pasting.

E.g. Since trying to paste 3 non-adjacent rows into row 10, 11 and 12, often puts all 3 rows into row 10 with one row in fields A10-P10, the next row in Q10-AF10 and the last row into AG10-AV10...

I edited the Macro below to fix this mistake when this happens.

So, for example, I can now highlight row 10 and run the macro to cut/insert the fields Q10-AF10 to A11-P11 and delete/shift left the blank fields now in Q10-AF10.

I'm hoping for help to loop this process until there's no data outside Column A-P. In this case, no data outside cell P10.

         Sub FixAllOnLine1OneRowAtATimeInsertToNextRow()

    Application.ScreenUpdating = False
        Dim copySheet As Worksheet
        Dim pasteSheet As Worksheet

        Set copySheet = ActiveSheet
        Set pasteSheet = ActiveSheet

        copySheet.Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Copy
        Range("Q" & ActiveCell.Row & ":AF" & ActiveCell.Row).Offset(1).Select

        pasteSheet.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Application.ScreenUpdating = True
        Columns("Q:AF").Select
        Selection.Delete Shift:=xlToLeft

    End Sub

 

[wittonlin]

Beautifully perfect!

Thanks Gallen!

I wasn't sure what to do with the Function, but just having it below the Sub just like you have it works great! I was thinking it might have to go into the Intermediate window for that module?? Since you wrote the first Macro or reworked it from somewhere, really just because it's bugging the crap out of me....do you know the Offset parameters to 'insert' the copied cell range into the row right below the selected row and not into the range A2:P2?

 

[gallen]

Glad it works. How do you mean with the offset. The code should insert all the copied cells directly below whichever row is selected, not just below A2:P2?

 

[wittonlin]

No I meant your original code. I worked on it for an hour and it's driving me crazy!

It's somewhere in here and I know it's 1 or 2 number changes! I wouldn't ask but all code is useful at some point and I always struggle with Offset stuff when moving around the worksheet.

    ws.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).Insert xlShiftDown ' Paste the copied values in to column "A" on next row?
    'lNextRow = ws.Range("A" & Rows.count).End(xlUp).Row + 1 'Get Next Row number
    'Range("A" & lNextRow).PasteSpecial xlPasteValues

 

[gallen]

No I meant your original code. I worked on it for an hour and it's driving me crazy!

It's somewhere in here and I know it's 1 or 2 number changes! I wouldn't ask but all code is useful at some point and I always struggle with Offset stuff when moving around the worksheet.

    ws.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).Insert xlShiftDown ' Paste the copied values in to column "A" on next row?
    'lNextRow = ws.Range("A" & Rows.count).End(xlUp).Row + 1 'Get Next Row number
    'Range("A" & lNextRow).PasteSpecial xlPasteValues

OK apologies but now I'm really confused. Does the 2nd code snippet that I posted, that you said was perfect, work or not?

That line of code that you highlight above:

[COLOR=#333333]ws.Cells(ActiveCell.Row, 1).End(xlUp).Offset(1, 0).Insert xlShiftDown [/COLOR]

just inserts a row below the active cell, nothing more. The other 2 lines are wrong as they get the next empty row at the bottom of the sheet but they have been commented out anyway so will not execute.

 

[wittonlin]

No no it does work perfectly!

Your other code is what was driving me nuts. Not too mention I need to get the Offset code down.

Thing is that the code pull the correct selected row Q:AF but instead of "inserting" into the row below, it puts it into A2:P2. And unless there's some blank rows then it puts the range Q:AF two rows below the last blank row.

Sub FixAllOnLine1OneRowInsertToNextRowAllAtOnce2()

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?
    '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
    
End Sub

 

[gallen]

I ignored all that code because it was too confusing. While I understood what you were trying to achieve, I felt it needed re-writing.

Pardon my apparent stupidity, but if the other code works perfectly, why are you concentrating on the code that doesn't? The code that works was designed to replace the code that doesn't.

Offset is quite easy to understand, it gets a range that is OFFSET from the original cell where the first number is number of rows and the 2nd is columns. so for example if you had:

Range("A1").Offset(1,1).Value = "This is the cell that is offset from A1 by 1 row and 1 column"

Cell "B2" would read: "This is the cell that is offset from A1 by 1 row and 1 column"

Just try it.