Private Sub XfrCompPL()
Dim rngC1 As Range ' the range for Company
Dim FirstRow As Long
Dim RowCount As Long
Dim NewCName As String ' company name
Dim OldCName As String ' company name
Dim wsC1 As Worksheet ' target new worksheet name

Set OldSht = ActiveSheet
FirstRow = 1
LastRow = OldSht.Range("A" & Rows.Count).End(xlUp).Row
OldCName = Split(OldSht.Range("A1").Value, " ")(0)
For RowCount = 1 To LastRow
NewCName = Split(OldSht.Range("A" & (RowCount + 1)).Value, " ")(0)
If OldCName < NewCName Then
Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) '
wsC1.Name = OldCName ' name the sheet
Set rngC1 = OldSht.Rows(FirstRow & ":" & RowCount)
rngC1.Copy Destination:=wsC1.Rows(1) ' copy to it
FirstRow = RowCount + 1
OldCName = NewCName
End If
Next RowCount
End Sub


"sutha" wrote:

Could someone please help me modify the following macro and use.
In this Macro the range is set as every 20 raws. I like to use with data
that has different size range. Can I set a page break for each company range
and use? If so
how to change below/
Thanks

Private Sub XfrCompPL()
Dim rngC1 As Range ' the range for Company
Dim nCol As Long ' number of columns
Dim strCName As String ' company name
Dim wsC1 As Worksheet ' target new worksheet name

nCol = ActiveSheet.UsedRange.Columns.Count
Set rngC1 = ActiveSheet.UsedRange.Range("A1") ' first cell
Do While rngC1.Value < ""
strCName = Split(rngC1.Value, " ")(0) ' first word is company

Set rngC1 = rngC1.Resize(20, nCol) ' range is the company's

Set wsC1 = Worksheets.Add(after:=Worksheets(Worksheets.Count) ) '

wsC1.Name = strCName ' name the sheet
rngC1.Copy Destination:=wsC1.[A1] ' copy to it
Set rngC1 = rngC1.Range("A1").Offset(20) ' next company
Loop
End Sub