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?
|