coping rows using a loop... please advise
 

:confused:

Hello everyone i have a problem with a macro i am creating. There i
probably a really easy answer to this question, but i cant figure i
out. I need to know how to only copy the 4 rows following the cel
that contains "station number". These rows then need to be paste
into a new worksheet. This process must be done 12 times per wor
sheet. There are 12 cells containing the text "station number" and
need the 4 rows after each one. There are also numerous worksheet
that need to be procecced in the same manner. If anyone could help i
would be greatly appreciated.

P.S. I managed to create the code shown below. I dont know how muc
of it is correct. This is my first attempt at writing a macro :)


Dim Snum As Integer
Dim xi As Integer

Snum = 0
xi = 0
If (BSnum = STATION_NAME) Then
Range("B" & Snum :"BI" & (Snum + 3)").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B" & xi).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
xi = xi + 4
Else
Snum = Snum + 1
End I

--
jim hense
-----------------------------------------------------------------------
jim hensen's Profile: http://www.excelforum.com/member.php...fo&userid=1515
View this thread: http://www.excelforum.com/showthread.php?threadid=26889

coping rows using a loop... please advise
 

Try this Jim

I use this range Sheets("Sheet1").Range("A1:A100")
It will copy the rows to "Sheet2"


Sub Copy_To_Another_Sheet_1()
Dim FirstAddress As String
Dim MyArr As Variant
Dim Rng As Range
Dim Rcount As Long
Dim I As Long

Application.ScreenUpdating = False
'You can also use more values in the Array
MyArr = Array("station number")

Rcount = 1
With Sheets("Sheet1").Range("A1:A100")

For I = LBound(MyArr) To UBound(MyArr)
'Note : I use xlPart in this example and not xlWhole
Set Rng = .Find(What:=MyArr(I), _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rng.Offset(1).Resize(4).EntireRow.Copy _
Sheets("Sheet2").Rows(Rcount)
Set Rng = .FindNext(Rng)
Rcount = Rcount + 4
Loop While Not Rng Is Nothing And Rng.Address < FirstAddress
End If
Next I
End With
Application.ScreenUpdating = True
End Sub



--
Regards Ron de Bruin
http://www.rondebruin.nl


"jim hensen" wrote in message ...

:confused:

Hello everyone i have a problem with a macro i am creating. There is
probably a really easy answer to this question, but i cant figure it
out. I need to know how to only copy the 4 rows following the cell
that contains "station number". These rows then need to be pasted
into a new worksheet. This process must be done 12 times per work
sheet. There are 12 cells containing the text "station number" and i
need the 4 rows after each one. There are also numerous worksheets
that need to be procecced in the same manner. If anyone could help it
would be greatly appreciated.

P.S. I managed to create the code shown below. I dont know how much
of it is correct. This is my first attempt at writing a macro :)


Dim Snum As Integer
Dim xi As Integer

Snum = 0
xi = 0
If (BSnum = STATION_NAME) Then
Range("B" & Snum :"BI" & (Snum + 3)").Select
Selection.Copy
Sheets("Sheet1").Select
Range("B" & xi).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
xi = xi + 4
Else
Snum = Snum + 1
End If


--
jim hensen
------------------------------------------------------------------------
jim hensen's Profile: http://www.excelforum.com/member.php...o&userid=15155
View this thread: http://www.excelforum.com/showthread...hreadid=268890