Sub CutNPaste()
Dim rng As Range

Set rng = [a8:m8]
While rng(1, 1) < ""
rng.Cut rng.Offset(-1, rng.Columns.Count)
Set rng = rng.Offset(3, -rng.Columns.Count)
Wend
DeleteEmptyRows

End Sub

Function DeleteEmptyRows()
'Dave Braden excel.programming
Dim L As Long, rng As Range

On Error Resume Next
With ActiveSheet.UsedRange.Columns
Set rng = .Item(1).SpecialCells(4).EntireRow
If rng Is Nothing Then Exit Function
'adapted to start at row8, normally starts at l=2
For L = 8 To .Count
Set rng = Intersect(rng, .Item(L).SpecialCells(4).EntireRow)
If rng Is Nothing Then Exit Function
Next
End With
rng.Delete
End Function



keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


bjmccready wrote:

Hi I am trying to put data from two rows onto one row -

I have thousands of rows but I need help in coming up with a way of
doing the job in bulk.

The code below represents what I want to do i.e. take every even row
(starting at row 8) and paste it onto the end of the previous row.


Sub Consol()

Range("A8:M8").Select
Selection.Cut
Range("A10:M10").Select
Selection.Cut
Range("A12:M12").Select
Selection.Cut

End Sub


Your help would be much appreciated.

Thanks

Brian


---
Message posted from http://www.ExcelForum.com/