Copy to new worksheets

[lapta301]

Dear All

I have some spreadsheets containing substantial rows of data that come in from our main frame.

I need to copy the rows of data from Sheet1 to new sheets for each office with the sheets named after each office number that is in column H

The one I am currently working on extends from A1 to L2387 but the size changes each time although the sort field is always H. In this ine office 106 has 300 records and office 6300 has 860 records.

I have noticed that there is an apostrophe in front of the number but Excel will sort it properly after asking if I want text that looks like numbers sorted like numbers.

Many thanks

 

[Prestige83]

Hi VoG,

I have to admit that the above is impressive!

I have one request although: what if the column H has ALSO empty cells in addition to those which have information about the office as above? Could there be a code for naming the sheet of empty ones on particular way (for example "erroneous" - I would like this to be a variable that the user can't change but I as the "coder" could).

I would like them to be handled in the same way as the regular cells in column H (sorted, pasted to different worksheets and the VBA asks if you want to save as separate worksheets - as above)

Br,
Prestige

 

[Prestige83]

Hi VoG,

I have to admit that the above is impressive!

I have one request although: what if the column H has ALSO empty cells in addition to those which have information about the office as above? Could there be a code for naming the sheet of empty ones on particular way (for example "erroneous" - I would like this to be a variable that the user can't change but I as the "coder" could).

I would like them to be handled in the same way as the regular cells in column H (sorted, pasted to different worksheets and the VBA asks if you want to save as separate worksheets - as above)

Br,
Prestige

And may I add to the above, is there a way to add to the name of the saved files the last calendar day of previous month? And is it somehow possible to hide (or preferred: remove) columns from the files which are created, for example the column H?

The code which I am using here is in post #10 of this thread.

Thank you!

 

[TM1986]

Hey VOG,

Let me first quote that this is an absolute gem of a code. Would request you to help out with some modifications.
I have a pivot and an additional file in the master file that needs to be added to each of these new files created. Also the format needs to be same in each of the newly created files. Can any thing be added to the code to help out with this.

I found a modified version at page 5 for same formatting but that removes the header row.


Thanks a ton

 

[scott_ripley]

Hi, I just stumbled upon this code and thread trying to break up an excel sheet into multiple files.

This code worked for me however the formatting in the header, column width, row height were not included. Is there a way to maintain the overall format from the original sheet with all of the new files?

Thanks,

As per your PM this will allow copies of the separated sheets to be saved to individual workbooks.

Sub Lapta()
Dim LastRow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long
Dim ws As Worksheet, r As Range, iCol As Integer, t As Date, Prefix As String
Dim sh As Worksheet, Master As String
On Error Resume Next
Set r = Application.InputBox("Click in the column to extract by", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
iCol = r.Column
t = Now
Application.ScreenUpdating = False
With ActiveSheet
    Master = .Name
    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:=Cells(2, iCol), Order1:=xlAscending, _
        Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    iStart = 2
    For i = 2 To LastRow
        If .Cells(i, iCol).Value <> .Cells(i + 1, iCol).Value Then
            iEnd = i
            Sheets.Add after:=Sheets(Sheets.Count)
            Set ws = ActiveSheet
            On Error Resume Next
            ws.Name = .Cells(iStart, iCol).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
MsgBox "Completed in " & Format(Now - t, "hh:mm:ss.00"), vbInformation
If MsgBox("Do you want to save the separated sheets as workbooks", vbYesNo + vbQuestion) = vbYes Then
    Prefix = InputBox("Enter a prefix (or leave blank)")
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> Master Then
            sh.Copy
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Prefix & sh.Name & ".xls"
            ActiveWorkbook.Close
        End If
     Next sh
     Application.ScreenUpdating = True
End If
End Sub

 

[richsoby]

This has been a great thread and I am working on it to meet what I need. I was looking for a simple code to just limit the number of rows of data (say 15) from a table in order to link into a PPT and be readable. I never know how many rows of data I will have, but more than 15 is unreadable in PPT. Then to make it a little tougher - I use filters in the table to reduce the full data set to what I need. The code seems to see all the data in the table, not just the filtered data - any ideas or do I need to copy the filtered data to another table??

 

[helpexcel]

I use this code all the time, it's fantastic. I was wondering how would I alter it so that it only created a new sheet for items that say "Apple" in Column A?

 

[jeffreybrown]

If you are just wanting to more rows where they equal Apple

Sub FilterData()
    Dim r As Range
    Set r = Worksheets("Sheet1").Range("A1", Range("A" & Rows.Count).End(xlUp))
    r.AutoFilter Field:=1, Criteria1:="Apple"
    r.Copy Destination:=Worksheets("Sheet2").Range("A1")
    r.AutoFilter
End Sub

 

[helpexcel]

Thanks, but I was looking to add a filter into the existing code so that I could select a column and also a "phrase". Some of my spreadsheets have a significant amount of different entries and I don't want to add all of those sheets to my workbook, only the ones with the specific value/values I choose.

 

[BEVO20]

I don't know if this thread is still active but I am using this code now and it is really great! Thank you!
I have just one question. Does anyone know what the limit of files is that can be created? It works perfectly fine when I have 30 files that have to be created but when I had 400 files it did made the seperate sheets but they couldn't be saved to all seperate files.