Help with a macro.

[Guest]

Hi,
I've recorded the macro shown below. The idea is to look down a spreadsheet
with several thousand rows, looking in column D for "statistical", selecting
the row with the word statistical on it, and the next 22 rows; cutting the 23
rows and pasting into another sheet.
I want to adjust the macro so that, having run it the first time, I run it
again and it finds the next 23 rows starting with "statistical. Cut those
rows and paste on the other sheet below the first batch of 23 rows. Then keep
on running the macros until it finds all the "blocks of rows" starting with
"statistical. I will then end up with a sheet containing, say ten blocks of
rows, each of 23 rows, one beneath the other.
I'm a novice at this, so some help would be very appreciated.
Thanks for looking.
Paul



Columns("D").Select
Selection.Find(What:="Statistical", After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Rows("743:765").Select
Range("C743").Activate
Selection.Cut
Sheets("Sheet1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A2").Select
ActiveSheet.Paste
Cells.Select
Cells.EntireColumn.AutoFit
Range("A11").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range("A25").Select
End Sub

 

[Don Guillett]

A look in vba help index for FINDNEXT will help. This is a modification

Sub findmove()
With Worksheets(5).Range("b1:b40")
On Error GoTo quitit
Set c = .Find("ss", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do

x = Sheets("sheet4").Cells(Rows.Count, "a").End(xlUp).Row + 1
'c.Value = 5
c.Resize(23, 1).Cut Sheets("sheet4").Cells(x, 1)

Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
quitit:
End Sub

 

[Guest]

try something like this - may need a little tweaking, but I think it's what
you need:
sub test

Dim rngFound As Range
Dim sStart As String
Dim sDestRange As String

Sheet1.Activate
sStart = "D1"
sDestRange = "D1"

Range(sStart).Select

Set rngFound = Cells.Find(What:="Statistical", After:=ActiveCell,
LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)

Do While Not rngFound Is Nothing

If Not rngFound Is Nothing Then
Range(rngFound.Offset(1, 0).Address, rngFound.Offset(23,
0).Address).EntireRow.Cut
Sheet2.Activate
Range(sDestRange).Offset(0, -3).Select
ActiveSheet.Paste

sDestRange = Range(sDestRange).End(xlDown).Offset(1, 0).Address

Sheet1.Activate
End If

Range(rngFound.Offset(1, 0).Address).Activate

Set rngFound = Cells.FindNext(After:=ActiveCell)

' sanity check
If rngFound.Offset(1, 0).Text = "" Then Exit Do
Loop
end sub
<<<< END CODE <<<<

HTH

Philip

 

[Guest]

Thanks for the help guys, it's really appreciated. I managed to get it to
work just as I wanted!

Thanks

Paul