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