View Single Post
 
Old 06-25-2017, 03:24 PM
Logit Logit is offline Windows 10 Office 2007
Expert
 
Join Date: Jan 2017
Posts: 591
Logit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the roughLogit is a jewel in the rough
Default

.
Here is one way to accomplish the goal :

Code:
Option Explicit

Sub Macro1()
Dim Pos As Integer
Dim LC As Variant
Pos = 1

Application.ScreenUpdating = False

MainLoop:

LC = Cells(Pos, Columns.Count).End(xlToLeft).Column
Range(Pos + 1 & ":" & Pos + LC - 1).Insert Shift:=xlDown
Range(Cells(Pos, 2), Cells(Pos, LC)).Copy
Cells(Pos + 1, 1).PasteSpecial Transpose:=True
Range(Cells(Pos, 2), Cells(Pos, LC)).Clear
Pos = Pos + LC
If Cells(Pos, 1) <> "" Then GoTo MainLoop

Range("A2:A4").EntireRow.Delete
Range("A1").Value = "Sorted"
Columns(1).AutoFit

Application.ScreenUpdating = True

InsertBlankRows

End Sub

''/// For a set range of rows in a column
Sub InsertBlankRows()
'Step1:  Declare your variables.
    Dim MyRange As Range
    Dim iCounter As Long
    
Application.ScreenUpdating = False
    
'Step 2:  Define the target Range.
    Set MyRange = Range("A2:A50")
    
'Step 3:  Start reverse looping through the range.
    For iCounter = MyRange.Rows.Count To 1 Step -4
    
'Step 4: Insert two blank rows.
    MyRange.Rows(iCounter).EntireRow.Insert

'Step 5: Increment the counter down
    Next iCounter
    
Application.ScreenUpdating = True

End Sub
Attached Files
File Type: xlsm Rows Many 2 One Column.xlsm (18.4 KB, 18 views)
Reply With Quote