help please! - Search multiple spreadsheets for a worksheet name

[SteveH]

Sorry already posted something similar but I don't think I have been
very clear so here goes again.

I have a master spreadsheet containing lots of worksheets. Each
worksheet holds performance data for specfic fund and each worksheet is
named with the funds shortname.

I have a number of fund spreadsheets in residing in one directory each
with the long name for that fund and containing static fund data.
Within each fund spreadsheet there is a worksheet named after the fund
shortname (as in the master spreadsheet).

For each worksheet in the master spreadsheet I need to find the
matching worksheet in the correct fund spreadsheet and copy the data
across. This means copying about 20sets of data from seperate
worksheets in the master spreadsheet into the worksheet of the correct
fund spreadsheet. Each time the range of data to be copied is B265.

Hope this makes sense and I hope you can help me!

Steve

 

[Ron de Bruin]

Ok, I understand you now
I will post a example for you after drinking coffee

 

[Ron de Bruin]

Ok Steve try this macro with function

It will open all files in the folder C:\Data and loop through all sheets in each workbook
If the sheet exist in the basebook(workbook with the code) it will copy the range
B265 from the basebook into mybook in B2 ?

Let me know if this is what you want

Sub Copyrange_2()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim sh As Worksheet

'Fill in the path\folder where the files are
MyPath = "C:\Data" 'or "\\Username\SharedDocs"
'Add a slash at the end if the user forget
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp
Application.ScreenUpdating = False

Set basebook = ThisWorkbook
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
For Each sh In mybook.Worksheets
If SheetExists(sh.Name, basebook) Then
Set sourceRange = basebook.Worksheets(sh.Name).Range("B265")
Set destrange = mybook.Worksheets(sh.Name).Range("B2")
sourceRange.Copy destrange
End If
Next sh

mybook.Close savechanges:=True
Next Fnum

CleanUp:
Application.ScreenUpdating = True
End Sub

Function SheetExists(SName As String, _
Optional ByVal WB As Workbook) As Boolean
'Chip Pearson
On Error Resume Next
If WB Is Nothing Then Set WB = ThisWorkbook
SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function

 

[SteveH]

That is absolutely perfect, works a treat!

Thank you so much!!!!!!!

 

[Ron de Bruin]

Hi Steve

That is absolutely perfect, works a treat!

Great

Thanks for the feedback