Search , then copy and paste from multiple worksheets. VBA help

[sy288]

HI,
Here's what I have
1. A summary sheet with rows for each candidates. looks sth like this.

Gemma Anthony P. Male House RI 1
Lynch William J. Male House RI 1

2. 15 files containing individual worksheets for each candidate whose data needs to be aggregated. e.g. sheet 1 for Gemma, sheet 2 for Lynch.

I aim to accomplish these steps with a macron:
1. SEARCH for the individual sheet that contains candidate last name (column A in summary sheet,column A in individual sheet followed by first name )
2. ACTIVATE this individual sheet, COPY a certain range of cells (K1:K70, the same for all sheets)
3. PASTE SPECIAL these cells (select only values, transpose) to the summary sheet, at P CELL of the row of the candidate.

I appreciate your help in advance. If you think this is difficult, can you assess its level of complexity so that I could seek appropriate help?

 

[Ben McClave]

Hello,

The macro I wrote below should work (assuming that I fully understood your parameters). You may need to tweak it in a few places for it to work. I included a lot of comments to help you determine what changes might be necessary.

Hope this helps,
Ben

Sub CopyCandidates()
Dim wsSummary As Worksheet
Dim ws As Worksheet
Dim rNames As Range
Dim strCopyRange As String
Dim rC As Range

strCopyRange = "K1:K70" 'Range to copy as a string
Set wsSummary = Sheet1 'Summary sheet
Set rNames = wsSummary.Range("A1:A15") 'Range with Names to search

Application.ScreenUpdating = False 'Increases speed of macro

For Each rC In rNames 'For each cell in the Name list...
For Each ws In ThisWorkbook.Worksheets '...loop through each sheet to find the Name
ws.Activate 'Activate the sheet first
If ws.CodeName = wsSummary.CodeName Then GoTo NextSheet 'Skip the Summary sheet
On Error Resume Next 'Skips errors when not found
ws.Range("A:A").Find(What:=rC.Value, After:=ws.Range("A10000"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:= _
False, SearchFormat:=False).Activate 'Try to activate the found cell
If Err.Number = 0 Then 'Found cell could be activated...
ws.Range(strCopyRange).Copy '...so copy the data...
rC.Offset(0, 15).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True '...and paste as values, transposed to column P of Summary
GoTo NextCell 'No need to search remaining sheets, so move on to next name
Else
Err.Clear 'If it was an error, then Name not found, clear the error for next sheet.
End If
NextSheet:
Next ws
NextCell:
Next rC

'Clean up the variables and return the application to normal
Application.CutCopyMode = False
wsSummary.Activate
Application.ScreenUpdating = True

Set wsSummary = Nothing
Set ws = Nothing
Set rNames = Nothing
Set rC = Nothing

End Sub