Help with a macro.
try something like this - may need a little tweaking, but I think it's what
you need:
CODE
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
"Paul" wrote:
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: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
|