Alex
Alex

Reputation: 29

Loop through rows to copy and paste special

Spreadsheet has data like this:

      A                B    C   D    E
2  20120425 09:55:00  101  99  102  100.50   
3  20120425 09:55:00  101  102  98  101.50

I want to do this on the same sheet:

      H       
2  101    
3  99   
4  102  
5  100.50

Copy range B2:E2 then select H2 and paste special (it will get paste on H2, H3, H4, H5). Then repeat the task for B3:E3 copy the range and paste special on H6.

I recorded the macro but the task has to repeat on nearly 5000 rows.

Recorded code

Sub Macro9()
'
' Macro9 Macro
'

'
    Range("D1:G1").Select
    Selection.Copy
    Range("L1:L4").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("D2:G2").Select
    Selection.Copy
    Range("L5:L8").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
End Sub

Upvotes: 0

Views: 1647

Answers (1)

Alex
Alex

Reputation: 29

Somehow figured out the answer.

Sub alex4()

Dim k As Integer, i As Integer, lngRows As Integer    

lngRows = Range("A1").CurrentRegion.Rows.Count    

For k = 1 To (lngRows * 4)         

    For i = 1 To lngRows    

        k = k + 4   

        Range(Cells(i, 4), Cells(i, 7)).Select    

        Selection.Copy    

        Range(Cells(k, 12), Cells(k + 3, 12)).Select    

        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
          False, Transpose:=True    

    Next i    

Next k      

End Sub

Upvotes: 1

Related Questions