Excel Macro code help - re pasting rows

[bjmccready]

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 o
doing the job in bulk.

The code below represents what I want to do i.e. take every even ro
(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

Bria

 

[keepITcool]

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 >

 

[Patrick Molloy]

Sub Move()

Dim ThisRow As Long ' row to copy
Dim FirstCol As Long ' first col of row
Dim LastCol As Long ' calculated last col
Dim Cols As Long ' width of row to be copied
Dim source As Range 'pointer to data to be copied
Dim target As Range ' pointer to range where data
will be copied

FirstCol = 1 ' A - SET as DEFAULT
Cols = 9 ' A...J SET AS DEFAULT
LastCol = FirstCol + Cols


ThisRow = Cells(65000, FirstCol).End(xlUp).Row

Do Until ThisRow <= 7

'set pointers to the source and target
Set target = Range(Cells(ThisRow - 1, LastCol +
1), Cells(ThisRow - 1, LastCol + 1 + Cols))
Set source = Range(Cells(ThisRow, FirstCol), Cells
(ThisRow, LastCol))

'copy the data
target.Value = source.Value

Rows(ThisRow).Delete

' get the next row
ThisRow = ThisRow - 2

Loop


End Sub

Patrick Molloy
Microsoft Excel MVP