Macro runs in 2013 but not 2016

[Amateur hour]

Hi all,

First off, I'm not a programmer, I just Mr Magoo my way through this stuff, copying and modifying stuff I find online. I hate to be the guy that signs up just to ask a question but after a day of searching and messing around, I'm still lost. So, thanks in advance!!

I have a macro that takes a set of numbers in columns A:J and lines them up in the A column, in order. After Row 1, (9) blank rows are inserted then B1:J1 are copied and transposed to A2:A10. Then the loop runs again, inserting (9) blank rows again under row 11. Everything works dandy in Excel 2013.

In Excel 2016, the loop runs as intended the first time. Then when the loop runs the 2nd time, the values that were copied in the first loop (B1:J1) are inserted as a new row instead of inserting the (9) new blank rows.



This is the problem line:

    Row(iRow + 1 & ":" & iRow + 9).EntireRow.Insert

And the macro:

Dim rng As Range
Dim iRow As Integer
Dim lastCell As Integer
Dim LCx9 As Integer
Dim lastRow As Long
 
Range("A1").Select
Set rng = ActiveCell.CurrentRegion
lastCell = rng.Columns(1).Rows.Count + 1
LCx9 = (lastCell * 9) + lastCell
    For iRow = 1 To LCx9
    Row(iRow + 1 & ":" & iRow + 9).EntireRow.Insert
    Range(Cells(iRow, 2), Cells(iRow, 10)).copy
    Range(Cells(iRow + 1, 1), Cells(iRow + 9, 1)).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    iRow = iRow + 9
Next iRow

 

[mart37]

Rows(iRow + 1 & ":" & iRow + 9).EntireRow.Insert

 

[Leith Ross]

Hello Amateur hour,

Here is your macro with a little more polish added for speed and flexibility...

Sub Test()


    Dim rng     As Range
    Dim iRow    As Long
    Dim k       As Long
    Dim row     As Long
 
        ' Number of columns to copy and paste as rows.
        k = 9
        
        Set rng = Range("A1").CurrentRegion
        
        ' Remove the headers in row 1.
        Set rng = Intersect(rng, rng.Offset(1, 0))
        
        ' Speed up the macro by not showing each cut and paste.
        Application.ScreenUpdating = False
        
            For iRow = 1 To rng.Rows.Count * k Step k
                row = row + 1
                rng.Cells(iRow, 1).Resize(k, 1).Insert xlShiftDown
                rng.Cells(row, 2).Resize(1, k).Copy
                rng.Cells(iRow, 1).Resize(k, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Next iRow
        
        ' Allow updates to be shown again.
        Application.ScreenUpdating = True
        
        ' Remove highlights from cells to be copied.
        Application.CutCopyMode = False
        
End Sub

 

[Amateur hour]

Rows(iRow + 1 & ":" & iRow + 9).EntireRow.Insert

Thanks! Unfortunately, that was just a mistake. I spent a little time cleaning up my code, removing the unnecessary stuff and comments. The S was simply lost in translation, like I said, the code works well in 2013.

Hello Amateur hour,

Here is your macro with a little more polish added for speed and flexibility...

Sub Test()

.....
        
End Sub

Hi Leith,

Thanks, I appreciate your time!! I'll give this a try tomorrow (I don't have a computer with 2016 today).

 

[Amateur hour]

With Leith's code, I made some changes and ended up with something that worked in Excel 2013. Again, something in Excel 2016 doesn't like to insert rows. And again, the new code works in 2016 for the first For loop but then fails on the loops after the first.

Here's the main part of what I ended up with today:

For iRow = 1 To rng.Rows.Count * k Step k + 1               
row = row + 1
Range(Cells(iRow + 1, 1), Cells(iRow + k, k + 1)).Insert xlShiftDown
rng.Cells(iRow, 2).Resize(1, k).Copy
rng.Cells(iRow + 1, 1).Resize(k, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next iRow

Any new suggestions would be much appreciated! Have a great weekend!

 

[Leith Ross]

Hello Amateur hour,

Try inserting the rows starting from the end of the range like this...

For iRow = rng.Rows.Count * k To 1 Step -(k + 1)               
    row = row + 1
    Range(Cells(iRow + 1, 1), Cells(iRow + k, k + 1)).Insert xlShiftDown
    rng.Cells(iRow, 2).Resize(1, k).Copy
    rng.Cells(iRow + 1, 1).Resize(k, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next iRow

 

[Amateur hour]

Hello Amateur hour,

Try inserting the rows starting from the end of the range like this...

That's going to take some figuring out but I like the idea. Starting from the end and working up just eliminates the need to do any row inserting. Thanks!

 

[Amateur hour]

Leith,

Thanks again for the help! Here's what I ended up with and it works in both 2013 and 2016!
I had to add the lines after the loop for the last iteration since my k equations didn't line up.

For row = rng.Rows.Count To 2 Step -(1)
rng.Cells(row, 1).Resize(1, k + 1).Copy
rng.Cells(row * (k + 1) - k, 1).Resize(k, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Next row

rng.Cells(1, 2).Resize(1, k).Copy
rng.Cells(2, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Cheers!