copy data from one sheet to another

[Tiffany Eckman-Latchum]

Question..I have a sheet with multiple information on one sheet and I need to separate the data onto other sheets but don't want to have to copy and paste 139 times.  Any suggestions?? How to do this?? 

I need each of these on one sheet..and there are at least 139 of them and who ever typed it put all one one and i need them separated any way to do this????? 

Bus #	1			10/30/2017
Contractor:	XXXX
Schools Served:	XXXXX
Mileage
1st Run	33.24		1st Run	5.55
To Next Route	0.97		To Next Route	0.42
2nd Run	4.87		2nd Run	32.53
To 1st Stop	3.8		To 1st School	4.5
Total:	42.88		Total:	43
	Contract Mileage	85.88
Time Between Routes
A.M.			P.M.

[#2]

Ms Tiffany

I am not an Excel GURU - but I learned from this Forum many things and below is what I have learned so far from the assistance of many gracious men of this forum.

I made a SUB (pls see below) for you to test. (always make a backup copy of your data - just in case).

copy your data to another workbook and try it. 

I am assuming that all the records has 15 rows with columns A to E.

and there is no gap between rows of records.

In case the following does not help, there are many MVP's here to help you..

HTH

Sub AddSheetAndCopy()
    Dim i As Long, arow As Long, erow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    arow = 1
    erow = 15
    For i = 1 To 139
        Range(("A" & arow) & ":" & ("E" & erow)).Copy
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.name = "Newsheet" & Trim(Str(i))
        Range("A1").Select
        ActiveSheet.Paste
        arow = arow + 15
        erow = erow + 15
        ws.Select
    Next i
End Sub

[#3]

I think this is a better SUB - can be any number of data other than 139

Sub AddSheetAndCopy()
    Dim i As Long, arow As Long, erow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    With ActiveSheet
        Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
    Lastrow = Lastrow / 15
    arow = 1
    erow = 15
    For i = 1 To Lastrow
        Range(("A" & arow) & ":" & ("E" & erow)).Copy
        ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.name = "Newsheet" & Trim(Str(i))
        Range("A1").Select
        ActiveSheet.Paste
        arow = arow + 15
        erow = erow + 15
        ws.Select
    Next i
End Sub

[#4]

Ms. Tiffany

pls find as attached a sample for you to test..

thanks