View Single Post
  #9   Report Post  
Ken Wright
 
Posts: n/a
Default

OK, assumptions as follows:-

You have a Master workbook that matches exactly in structure (With the
exception of the chart sheet) every one of your 300 files.

Except for the chart sheet, the names of all the sheets in your Master
workbook are identical to those of the ones in your 300 files (Should have
been covered by first caveat, but better safe than sorry).

Your worksheet with the charts on it is called 2003 - 2005 (Note single
spaces around hyphen). Anythimg different to this you MUST look for the
string 2003 - 2005 in the code and change it to EXACTLY what your sheet is
called.

Your Master workbook does NOT have the same name as any one of those files.

Your Chart Sheet is not named the same as any of the existing sheets in any
file.

You have NO other Excel files in your directory structure. If you have then
move them out and then back again after.

You WILL try this first on either a small sample directory of copies, OR
make sure you back up your data first!!! Must must must do this!!! :-)



Hit ALT+F11 and this will open the VBE (Visual Basic Editor)
Top left you will hopefully see an explorer style pane. Within this pane
you need to search for
your workbook's name, and when you find it you may need to click on the + to
expand it. Within that you should see the following:-

VBAProject(Your_Filename)
Microsoft Excel Objects
Sheet1(Sheet1)
Sheet2(2003 - 2005)
Sheet3(Sheet3)
ThisWorkbook

If you have named your sheets then those names will appear in the brackets
above as opposed to what you see at the moment in my note (eg the 2003 -
2005 bit)

Right click on the where it says VBAProject(Your_Filename) and choose
'Insert Module' and it will now look like this

VBAProject(Your_Filename)
Microsoft Excel Objects
Sheet1(Sheet1)
Sheet2(Sheet2)
Sheet3(Sheet3)
ThisWorkbook
Modules
Module1

Double click the Module1 bit and then paste in to the white space that
appears, all the following code from between the marker lines (Not the lines
though)

Code Below (Don't copy this line - just the stuff below the marker lines)
===========================================

Option Explicit
Function PickFolder(strStartDir As Variant) As String
Dim SA As Object, F As Object
Set SA = CreateObject("Shell.application")
Set F = SA.BrowseForFolder(0, "Choose a folder", 0, strStartDir)
If (Not F Is Nothing) Then
PickFolder = F.items.Item.path
End If
Set F = Nothing
Set SA = Nothing
End Function

Sub CopyCharts()

Dim ffc As Long
Dim i As Long
Dim sc As Long
Dim TgtWkb As Workbook
Dim TgtWkbn As String
Dim TgtWks As Worksheet
Dim CurWkb As Workbook
Dim CurWkbn As String
Dim CurWks As Worksheet
Dim CurWksLrow As Long
Dim strStartDir As String
Dim UserFile As String

' On Error Resume Next
UserFile = PickFolder(strStartDir)
If UserFile = "" Then
MsgBox "Canceled"
End If

'CurWks will always refer to the Chart worksheet to be copied over
Set CurWkb = ActiveWorkbook
CurWkbn = CurWkb.Name
'This MUST be exactly what your sheet is called
Set CurWks = CurWkb.Worksheets("2003 - 2005")

Application.ScreenUpdating = False

With Application.FileSearch
.SearchSubFolders = True
.NewSearch
.Filename = ".xls"
.LookIn = UserFile
.FileType = msoFileTypeExcelWorkbooks
.Execute

ffc = .FoundFiles.Count

For i = 1 To ffc

'TgtWkb will always refer to the workbook you are copying the charts
to.
Set TgtWkb = Application.Workbooks.Open(Filename:=.FoundFiles(i ))
Application.StatusBar = "Currently Processing file " & i & " of " &
ffc

With TgtWkb
TgtWkbn = .Name
sc = .Sheets.Count - 1
CurWks.Copy After:=Workbooks(TgtWkbn).Sheets(sc)
.ChangeLink Name:=CurWkbn, NewName:=TgtWkbn, Type:=xlExcelLinks
.Save
.Close
End With

Next i
End With

Set TgtWkb = Nothing
Set TgtWks = Nothing
Set CurWkb = Nothing
Set CurWks = Nothing

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

===========================================
Code Above (Don't copy this line - just the stuff above the marker lines)

Then hit File / Close and return to Microsoft Excel and save the file. Now
just do Tools / Macro / Macros / CopyCharts, choose the top level directory
and hit OK.

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 97/00/02/03

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission :-)
----------------------------------------------------------------------------

<snip