Searching for specific name on main sheet then copying row dataassociated with name
Patrick,
I think that the macro below will do the trick with one small change to your sample workbook. The change I made was to put all the headers in row 1 and start the data in row 2 of the Main tab. With these changes, the following code should work out.
Ben
Sub CopyName()
Dim wsMain As Worksheet 'Main Worksheet
Dim wsFound As Worksheet 'John Doe Worksheet
Dim wsOther As Worksheet 'Not John Worksheet
Dim strName As String 'Name to search
Set wsMain = Sheet1 'Sheets ("Main")
Set wsFound = Sheet2 'Sheets ("John Doe")
Set wsOther = Sheet3 'Sheets ("Not John")
strName = "John Doe"
strName = InputBox("Please enter a name", "Name?", strName)
'Inserts criteria on Main sheet, then uses advanced filter to populate
'other sheets. Afterwards, criteria row is deleted.
'Assumes all headers started in row 1 and data starts in row 2
With wsMain
.Range("1:4").Insert
.Range("A1").Value = .Range("A5").Value
.Range("A2").Value = strName
wsFound.Range("A1:E1").Value = .Range("A5:E5").Value
wsOther.Range("A1").Value = .Range("A5").Value
.Range("A5").CurrentRegion.AdvancedFilter xlFilterCopy, .Range("A1:A2"), _
wsFound.Range("A1:E1"), False
.Range("A2").Value = "'<" & strName
.Range("A5").CurrentRegion.AdvancedFilter xlFilterCopy, .Range("A1:A2"), _
wsOther.Range("A1"), False
.Range("1:4").Delete
End With
Set wsMain = Nothing
Set wsFound = Nothing
Set wsOther = Nothing
End Sub
|