Copying text from master sheet to new sheets

[aidan_cov]

Hi,
I have a small problem regarding analysing mobile phone data. I receive a master sheet from the company's mobile phone suppliers listing all usage by all users by call. It appears on the spreadsheet as if it were a normal bill in terms of layout. In column A is the date of the call, column B time of call, column D number called, column F is duration and column O is cost of call amongst other unimportant data in the intervening columns. These are the important columns but it is not specifically important to this exercise. The data is displayed as if it were a paper bill so the headers for each person are repeated every 24 rows if they make more than 17 calls per month otherwise they are repeated below the totals for the previous person listed. The only thing that easily separates the data for this purpose is that there is text in column A at the foot of each individual's bill that states "Handset Total". It is at this point that I would like to break the data being copied to individual sheets. This would also mean that the sixth row in the copied sheet would contain the person's name which is what I would like to have displayed as the tab name.
I know this is probably asking a lot but any help at all would be gratefully received and would save a great deal of time each month in sending out the relevant sections of these bills to each individual.
Many thanks in advance.

 

[daverunt]

Hi,

Not sure how suitable this will be as an example sheet would be easier to work with for me. I've had to bodge one up from my interpretation of the description.

It all hinges on the 'Handset Total' as the last row to copy and filled Column to the right as the last column.
Once copied to a new sheet it takes pasted row A6 as the Sheet Name

I haven't taken into account headers but if the code works I'm sure it can be adapted to include it on each sheet.

Paste the macro into an old sheet and try it.

Sub SplitBill()
Dim Rng As Range
Dim Dn As Range
 
ThisWorkbook.Sheets("Sheet1").Activate
 
Set Rng = Range(Range("A:A"), Range("A" & Rows.Count).End(xlUp))
firstRow = 1
 
For Each Dn In Rng
    lastCol = ActiveSheet.Range("a1").End(xlToRight).Column
If InStr(Dn.value, "Handset Total") > 0 Then
    HSRow = Dn.Row
    ActiveSheet.Range("a" & firstRow, ActiveSheet.Cells(HSRow, lastCol)).Select
    firstRow = HSRow + 1
 
    Selection.Copy
    Worksheets.Add
    Selection.PasteSpecial
    ActiveSheet.Name = Range("A6").value
 
ThisWorkbook.Sheets("Sheet1").Activate
    Cells(HSRow + 1, 1).Activate
 
End If
 
Next Dn
MsgBox ("Macro Finished")
End Sub

 

[aidan_cov]

Hi Dave,
Many thanks for that. I have tried it and it started to work insofar as it created a new sheet and copied the data but then gave me an error 400. It did not copy any further data and it did not rename the sheet. The name to rename the sheet with appears in cell B6 rather than A6 but that was easily rectified. The "Handset Total" is indeed the last row to be copied and column O is the last column to be copied. You're nearly there and I am very grateful.
Many thanks and I hope you are able to assist me further.

 

[daverunt]

I've sent you a private message as I am going to need more information.

 

[aidan_cov]

Many thanks for sorting this out. I like the idea of putting it in a separate workbook and running it from there. It works like a dream and will certainly save a huge amount of work in the future. I do love this forum.