cut and past sub

[ksnapp]

hi,

This sub is supposed to look down column A and find the row number o
the last populated cell, then it divides that by 2 and round the numbe
up. Then it selects the cell in a with that row number. if that cel
is empty then it goes down one row at a time until it finds a cell tha
is not empty. It does all that just fine.

Now, I need it to cut from that cell(first non empty cell in column
below the 1/2 way point) to the last populated row from the first par
and coumn B, then paste all that stuff starting in C1

here is what I have

Sub row_counter()
Dim rw As Long
Dim h As Double
Dim n As Single
rw = Cells(Rows.Count, 1).End(xlUp).Row
h = rw / 2

n = Application.RoundUp(h, 0) + 1

Cells(n, 1).Select
Do Until ActiveCell <> Empty
ActiveCell.Offset(1, 0).Select
Loop

If cell <> Empty Then
Range(cell, Cells(rw, 2)).Select.Cut
End If

'Range("c1").Select.Paste

End Sub

help, pleas

 

[Dave Peterson]

I think this works the way you described.

(I changed some variable names--makes it easier for me to remember what they
represent.)

Option Explicit

Sub row_counter()
Dim myRow As Long
Dim HalfWayRow As Long
Dim TopCell As Range
Dim BotCell As Range

With ActiveSheet

Set BotCell = .Cells(.Rows.Count, 1).End(xlUp)
myRow = BotCell.Row

HalfWayRow = (myRow + 1) / 2

Set TopCell = .Cells(HalfWayRow, 1)

If IsEmpty(TopCell) Then
'check next row
If IsEmpty(TopCell.Offset(1, 0)) = False Then
Set TopCell = TopCell.Offset(1, 0)
Else
Set TopCell = TopCell.End(xlDown)
End If
End If

.Range(TopCell, BotCell).Resize(, 2).Cut _
Destination:=.Range("C1")
End With

End Sub