Macro Or Formula

  steviegee 10:55 09 Nov 2010

I have a spreadsheet with various info on. What I need to do is take all the information and put them in different sheets for me. In column E there are about 30 different numbers so whenever the same number appears I want it to take the information in the cells either side and put them on a new page. For example Column E may have the number 30 in it and have info either side 30 rows down, so I need it to take all the 30s and put them on sheet 2 and wheneve 40 appears in column E take all the info and put it on sheet 3 and so on. Hope u understand what I am getting at and that it is possible. Thanks.

  steviegee 13:36 09 Nov 2010


  KremmenUK 14:33 09 Nov 2010

I would tackle that with a Macro using a loop to step down the column and assess the value and take the necessary steps.

I think the activecell.value and the offset functions are probably the useful ones here.

However, I think Vog may have a slicker way of doing this so hang on for his reply.

  [email protected]© 18:11 09 Nov 2010


  VoG II 19:33 09 Nov 2010

This will copy entire rows to new sheets based on the value in column E. Run it with the 'parent' sheet selected. It assumes that row 1 contains headers - these will be copied to the 'child' sheet. Note that it will sort the data on the 'parent' sheet, so save a copy of the unsorted sheet first if you need that

Sub Lapta()
Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
.Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("E2"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
iStart = 2
For i = 2 To lastrow
If .Range("E" & i).Value <> .Range("E" & i + 1).Value Then
iEnd = i
Sheets.Add after:=Sheets(Sheets.Count)
Set ws = ActiveSheet
On Error Resume Next
ws.Name = .Range("E" & iStart).Value
On Error GoTo 0
ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value
.Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")
iStart = iEnd + 1
End If
Next i
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

An alternative is Excel Explosion.

  VoG II 19:34 09 Nov 2010

Oops, forgot the link click here

  steviegee 07:36 10 Nov 2010

Worked a treat, thanks.

This thread is now locked and can not be replied to.

Elsewhere on IDG sites

Dell XPS 13 9370 (2018) review

The art of 'British' pulp fiction

Best password managers for Mac

TV & streaming : comment regarder le Tournoi des Six Nations 2018 ?