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