Option Explicit
Sub Ken01()
  'Copy all rows with column 1 matching value
  ' of selected cell to next available row
  ' in sheet named with value of matching cell  2000-06-09
  ' 2007-04-25 create sheet if needed, return to original sheet
  Dim I As Long
  Dim original As Worksheet
  Application.ScreenUpdating = False
  'On Error Resume Next
  Dim mrow As Long
  mrow = Cells.SpecialCells(xlLastCell).Row
  Dim ThisText As String
  Dim Str1 As String
  Dim Row As Long
  ThisText = ActiveCell.Value
  'ThisText = InputBox("Supply Name to copy", , ThisText)
  'MsgBox "You chose" & ThisText
  If ActiveSheet.Name = ThisText Then
     MsgBox "You can't start from a sheet named " & ThisText
     Exit Sub
  End If
  Set original = ActiveSheet
  For I = 1 To mrow
    If Cells(I, 1) = ThisText Then
       Str1 = Str1 & "," & I & ":" & I
    End If
  Next I
  Str1 = Mid(Str1, 2, 2000)
  Range(Str1).Copy
  'Sheets("Bob").Activate
  On Error Resume Next
  Application.DisplayAlerts = False
  Sheets(ThisText).Activate
  If Err.Number <> 0 Then
    If Err.Number <> 9 Then MsgBox Err.Number & " -- error "
    '-- see http://www.mvps.org/dmcritchie/excel/sheets.htm
    Sheets.Add After:=Sheets(Sheets.Count)  '-- place at end
    'Rename current Sheet
    ActiveSheet.Name = ThisText
  End If
    Application.DisplayAlerts = True
  On Error GoTo 0
  If [A1].Value <> "" Then
    Cells(1, 1).End(xlDown).Select
   Row = ActiveCell.Row
   Range(Cells(Row + 1, 1), Cells(Row + 1, 1)).Select
  End If
  ActiveSheet.Paste
  original.Activate    'Return to original worksheet
  Application.ScreenUpdating = False
End Sub
| Cell A13 containing "Bob" is selected (boldface for display only). 
 
 | Sheetname: Bob 
 | 
Insert another row above your first row.
A1:  Name
B1:  Amount
Select row 1
Data --> Filter --> Autofilter
Click on arrow in Name column header (cell A1) ChooseBob Copy the area showing data (ctrl+c) Insert new worksheet (Edit --> Insert worksheet) Paste (ctrl+v) intot the new worksheet
Another possibility, simply select all of data and sort on Column A.
Please send your comments concerning this web page to: David McRitchie send email comments
Copyright © 1997 - 2004, F. David McRitchie, All Rights Reserved