View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
joel joel is offline
external usenet poster
 
Posts: 9,101
Default Look at numbers between 2 numbers and copy the complete rows to a

Here is another solution. Hope this works. Move the worksheet with the data
the 1st worksheet. The code below start at worksheet 2 so you are copying
the original data on worksheet(1) to new sheets starting at worksheet 2.


Sub completedrows()

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set ColARange = Range(Cells(1, "A"), Cells(Lastrow, "A"))

worksheetcount = 2
RowCount = 5
CellValue6 = False
For Each cell In ColARange

If cell.Value = 6 Then
CellValue6 = True
Rows(cell.Row & ":" & cell.Row).Copy Destination:= _
Sheets(worksheetcount).Rows(RowCount & ":" & RowCount)
RowCount = RowCount + 1
Else
If CellValue6 = True Then
worksheetcount = worksheetcount + 1
CellValue6 = False
RowCount = 5
End If
End If

Next cell


End Sub


Sub completedrows()

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row
Set ColARange = Range(Cells(1, "A"), Cells(Lastrow, "A"))

worksheetcount = 1
RowCount = 5
CellValue6 = False
For Each cell In ColARange

If cell.Value = 6 Then
CellValue6 = True
Rows(cell.Row & ":" & cell.Row).Copy Destination:= _
Sheets(worksheetcount).Rows(RowCount & ":" & RowCount)
RowCount = RowCount + 1
Else
If CellValue6 = True Then
worksheetcount = worksheetcount + 1
CellValue6 = False
RowCount = 5
End If
End If

Next cell


End Sub


"bartman1980" wrote:

I have only number in column A.
It could be a 5 or a 6.
Example:
A1=5
A2=6
A3=6
A4=5
A5=6
A6=6
A7=5
A9=6
A10=6
A11=6
A12=6

Now I want to copy ALL the complete rows between the cells with a 5.
Result:
Rows 2 and 3 should be copied to worksheet 1 starting in row 5
Rows 5 and 6 should be copied to worksheet 2 starting in row 5
Rows 9, 10, 11 and 12 should be copied to worksheet 3 starting in row
5

The input of the cells in column A can be different each month.

Can somebody help me with a VBA code?