easy way to split a sheet into multiple sheets?

we work with a process that involves receiving a large spreadsheet (that contains info for multiple companies), and need to segregrate out the rows specific to each company.  There is a "bank number" column which identifies the company, and it is sorted by this column. 

 

I'm looking for a quick way to say, at each break in bank number, create a new sheet.  Is this possible without any sort of visual basic/programming?  I'm trying to help find a quick solution for someone but don't have a lot of time to invest at this point.

 

thanks in advance!

Hi,


It's not possible to create sheets with a formula so you have choices and as I see it they are:-


1. Manually create the sheets then lots of copy and paste.

2. Manually create the sheets and then create lots of formula to reference the data sheet.

3. Use VB code.



Should option 3 be of interest the code below will do that. It will read down a column and copy to a sheet with the same name as the customer and if that sheet doesn't exist it will create it.


See the comments in the code for some small changes you may need to make.



Sub Copy_Data()
 Dim r As Range, LastRow As Long, ws As Worksheet
 Dim LastRow1 As Long, MyColumn As String
 Dim src As Worksheet
 'Change this column Letter to the one with the Co ID in
 MyColumn = "B"
 'Change the worksheet name to the one with the data on
 Set src = Sheets("Sheet1")
 LastRow = src.Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
 For Each r In src.Range(MyColumn & "2:" & MyColumn & LastRow)
         On Error Resume Next
         Set ws = Sheets(CStr(r.Value))
         On Error GoTo 0
         If ws Is Nothing Then
             Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = CStr(r.Value)
             'This row adds a header from the soyrce sheet
             'remove the ' if you want to do that
             'src.Rows(1).Copy ActiveSheet.Range("A1")
             LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
             src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
             Set ws = Nothing
         Else
             LastRow1 = Sheets(CStr(r.Value)).Cells(Cells.Rows.Count, MyColumn).End(xlUp).Row
             src.Rows(r.Row).Copy Sheets(CStr(r.Value)).Cells(LastRow1 + 1, 1)
             Set ws = Nothing
         End If
    
 Next r
 End Sub

If this response answers your question then please mark as answer.

Mike H

21 people found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

Hi,


You may refer to my solution at this link - http://www.ashishmathur.com/split-data-into-multiple-tabs/


Hope this helps.

Regards,

Ashish Mathur
www.ashishmathur.com
http://twitter.com/excelashish

1 person found this reply helpful

·

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated December 30, 2020 Views 14,522 Applies to: