Loop through, open, and modify all workbooks in file

[Jason]

I have some code which I found on this board previously. The code
essentially opens all Workbooks in a file directory ("Test" below), goes to
sheet 1 and puts the value 1000 in range A1. The code is essentially doing
what it is supposed to, however, I need to make it more complex. I will be
working from a workbook that serves as the master workbook ("Master.xls")
which also contains the coding. While having the "Master" workbook open, I
want it to open each workbook individually (the "Secondary" workbooks) in the
directory and perform the following steps:

(1) Delete "Sheet3" from the Secondary workbook (2) Create a copy of
"Sheet3" from the Master workbook and insert into the Secondary workbook (3)
Update links (there are formulas in sheet3) so they reference the secondary
workbook that is open (name of workbook varies depending on which one is
open) (4) Save the secondary workbook, close , and go onto the next file.

Here is what I have so far, any help on modifying this would be appreciated.
Thanks.


Sub UpdateTheData()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = True
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)

' I BELIEVE CODE WOULD GO HERE TO PERFORM STEPS ABOVE

Sheets("Sheet1").Select
Range("A1").Value = 1000
mybook.Close True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

[Tom Ogilvy]

Sub UpdateTheData()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = True
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
idex = mybook.Worksheets(3).Index
Application.DisplayAlerts = False
mybook.Worksheets(3).Delete
Thisworkbook.Worksheets(3).copy _
After:=mybook.Worksheets(index - 1)
Application.DisplayAlerts = False

'


mybook.Close True
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

For the code for updating the links, turn on the macro recorder and do it
manually (Edit=>Links) to get the code.

--
Regards,
Tom Ogilvy


"Jason" <[email protected]> wrote in message
news:[email protected]...
> I have some code which I found on this board previously. The code
> essentially opens all Workbooks in a file directory ("Test" below), goes
to
> sheet 1 and puts the value 1000 in range A1. The code is essentially
doing
> what it is supposed to, however, I need to make it more complex. I will
be
> working from a workbook that serves as the master workbook ("Master.xls")
> which also contains the coding. While having the "Master" workbook open,
I
> want it to open each workbook individually (the "Secondary" workbooks) in
the
> directory and perform the following steps:
>
> (1) Delete "Sheet3" from the Secondary workbook (2) Create a copy of
> "Sheet3" from the Master workbook and insert into the Secondary workbook
(3)
> Update links (there are formulas in sheet3) so they reference the
secondary
> workbook that is open (name of workbook varies depending on which one is
> open) (4) Save the secondary workbook, close , and go onto the next
file.
>
> Here is what I have so far, any help on modifying this would be
appreciated.
> Thanks.
>
>
> Sub UpdateTheData()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
> MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
> ChDrive MyPath
> ChDir MyPath
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
> Application.ScreenUpdating = True
> Set basebook = ThisWorkbook
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
>
> ' I BELIEVE CODE WOULD GO HERE TO PERFORM STEPS ABOVE
>
> Sheets("Sheet1").Select
> Range("A1").Value = 1000
> mybook.Close True
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>

[Jason]

Thanks Tom, that works great. I have used the macro recorder to come up with
some code to update links, but need just a little more help modifing this
part of it. In the code to update links, I need to provide the name of the
file ("Newname" below), however this changes as the code loops through all of
the files in the directory. How can I replace what is in "Test1.xls", so
that it always references whatever the name of the open file is (in other
words, "mybook")? Thank you.

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
idex = mybook.Worksheets(3).Index
Application.DisplayAlerts = False
mybook.Worksheets(3).Delete
ThisWorkbook.Sheets("Summary").Copy _
After:=mybook.Worksheets(2)
ActiveWorkbook.ChangeLink Name:="Main.xls", _
NewName:="Test1.xls", Type:= xlExcelLinks


"Tom Ogilvy" wrote:

> Sub UpdateTheData()
> Dim basebook As Workbook
> Dim mybook As Workbook
> Dim FNames As String
> Dim MyPath As String
> Dim SaveDriveDir As String
>
> SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
> MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
> ChDrive MyPath
> ChDir MyPath
> FNames = Dir("*.xls")
> If Len(FNames) = 0 Then
> MsgBox "No files in the Directory"
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Exit Sub
> End If
> Application.ScreenUpdating = True
> Set basebook = ThisWorkbook
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
> idex = mybook.Worksheets(3).Index
> Application.DisplayAlerts = False
> mybook.Worksheets(3).Delete
> Thisworkbook.Worksheets(3).copy _
> After:=mybook.Worksheets(index - 1)
> Application.DisplayAlerts = False
>
> '
>
>
> mybook.Close True
> FNames = Dir()
> Loop
> ChDrive SaveDriveDir
> ChDir SaveDriveDir
> Application.ScreenUpdating = True
> End Sub
>
> For the code for updating the links, turn on the macro recorder and do it
> manually (Edit=>Links) to get the code.
>
> --
> Regards,
> Tom Ogilvy
>
>
> "Jason" <[email protected]> wrote in message
> news:[email protected]...
> > I have some code which I found on this board previously. The code
> > essentially opens all Workbooks in a file directory ("Test" below), goes
> to
> > sheet 1 and puts the value 1000 in range A1. The code is essentially
> doing
> > what it is supposed to, however, I need to make it more complex. I will
> be
> > working from a workbook that serves as the master workbook ("Master.xls")
> > which also contains the coding. While having the "Master" workbook open,
> I
> > want it to open each workbook individually (the "Secondary" workbooks) in
> the
> > directory and perform the following steps:
> >
> > (1) Delete "Sheet3" from the Secondary workbook (2) Create a copy of
> > "Sheet3" from the Master workbook and insert into the Secondary workbook
> (3)
> > Update links (there are formulas in sheet3) so they reference the
> secondary
> > workbook that is open (name of workbook varies depending on which one is
> > open) (4) Save the secondary workbook, close , and go onto the next
> file.
> >
> > Here is what I have so far, any help on modifying this would be
> appreciated.
> > Thanks.
> >
> >
> > Sub UpdateTheData()
> > Dim basebook As Workbook
> > Dim mybook As Workbook
> > Dim FNames As String
> > Dim MyPath As String
> > Dim SaveDriveDir As String
> >
> > SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
> > MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
> > ChDrive MyPath
> > ChDir MyPath
> > FNames = Dir("*.xls")
> > If Len(FNames) = 0 Then
> > MsgBox "No files in the Directory"
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Exit Sub
> > End If
> > Application.ScreenUpdating = True
> > Set basebook = ThisWorkbook
> > Do While FNames <> ""
> > Set mybook = Workbooks.Open(FNames)
> >
> > ' I BELIEVE CODE WOULD GO HERE TO PERFORM STEPS ABOVE
> >
> > Sheets("Sheet1").Select
> > Range("A1").Value = 1000
> > mybook.Close True
> > FNames = Dir()
> > Loop
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Application.ScreenUpdating = True
> > End Sub
> >
>
>
>

[Tom Ogilvy]

If you want the change in the master workbook:

ThisWorkbook.ChangeLink Name:="Main.xls", _
NewName:=mybook.Name, Type:= xlExcelLinks

--
Regards,
Tom Ogilvy



"Jason" <[email protected]> wrote in message
news:[email protected]...
> Thanks Tom, that works great. I have used the macro recorder to come up
with
> some code to update links, but need just a little more help modifing this
> part of it. In the code to update links, I need to provide the name of
the
> file ("Newname" below), however this changes as the code loops through all
of
> the files in the directory. How can I replace what is in "Test1.xls", so
> that it always references whatever the name of the open file is (in other
> words, "mybook")? Thank you.
>
> Do While FNames <> ""
> Set mybook = Workbooks.Open(FNames)
> idex = mybook.Worksheets(3).Index
> Application.DisplayAlerts = False
> mybook.Worksheets(3).Delete
> ThisWorkbook.Sheets("Summary").Copy _
> After:=mybook.Worksheets(2)
> ActiveWorkbook.ChangeLink Name:="Main.xls", _
> NewName:="Test1.xls", Type:= xlExcelLinks
>
>
> "Tom Ogilvy" wrote:
>
> > Sub UpdateTheData()
> > Dim basebook As Workbook
> > Dim mybook As Workbook
> > Dim FNames As String
> > Dim MyPath As String
> > Dim SaveDriveDir As String
> >
> > SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
> > MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
> > ChDrive MyPath
> > ChDir MyPath
> > FNames = Dir("*.xls")
> > If Len(FNames) = 0 Then
> > MsgBox "No files in the Directory"
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Exit Sub
> > End If
> > Application.ScreenUpdating = True
> > Set basebook = ThisWorkbook
> > Do While FNames <> ""
> > Set mybook = Workbooks.Open(FNames)
> > idex = mybook.Worksheets(3).Index
> > Application.DisplayAlerts = False
> > mybook.Worksheets(3).Delete
> > Thisworkbook.Worksheets(3).copy _
> > After:=mybook.Worksheets(index - 1)
> > Application.DisplayAlerts = False
> >
> > '
> >
> >
> > mybook.Close True
> > FNames = Dir()
> > Loop
> > ChDrive SaveDriveDir
> > ChDir SaveDriveDir
> > Application.ScreenUpdating = True
> > End Sub
> >
> > For the code for updating the links, turn on the macro recorder and do
it
> > manually (Edit=>Links) to get the code.
> >
> > --
> > Regards,
> > Tom Ogilvy
> >
> >
> > "Jason" <[email protected]> wrote in message
> > news:[email protected]...
> > > I have some code which I found on this board previously. The code
> > > essentially opens all Workbooks in a file directory ("Test" below),
goes
> > to
> > > sheet 1 and puts the value 1000 in range A1. The code is essentially
> > doing
> > > what it is supposed to, however, I need to make it more complex. I
will
> > be
> > > working from a workbook that serves as the master workbook
("Master.xls")
> > > which also contains the coding. While having the "Master" workbook
open,
> > I
> > > want it to open each workbook individually (the "Secondary" workbooks)
in
> > the
> > > directory and perform the following steps:
> > >
> > > (1) Delete "Sheet3" from the Secondary workbook (2) Create a copy of
> > > "Sheet3" from the Master workbook and insert into the Secondary
workbook
> > (3)
> > > Update links (there are formulas in sheet3) so they reference the
> > secondary
> > > workbook that is open (name of workbook varies depending on which one
is
> > > open) (4) Save the secondary workbook, close , and go onto the next
> > file.
> > >
> > > Here is what I have so far, any help on modifying this would be
> > appreciated.
> > > Thanks.
> > >
> > >
> > > Sub UpdateTheData()
> > > Dim basebook As Workbook
> > > Dim mybook As Workbook
> > > Dim FNames As String
> > > Dim MyPath As String
> > > Dim SaveDriveDir As String
> > >
> > > SaveDriveDir = "C:\Documents and Settings\Jason\Desktop\Test"
> > > MyPath = "C:\Documents and Settings\Jason\Desktop\Test"
> > > ChDrive MyPath
> > > ChDir MyPath
> > > FNames = Dir("*.xls")
> > > If Len(FNames) = 0 Then
> > > MsgBox "No files in the Directory"
> > > ChDrive SaveDriveDir
> > > ChDir SaveDriveDir
> > > Exit Sub
> > > End If
> > > Application.ScreenUpdating = True
> > > Set basebook = ThisWorkbook
> > > Do While FNames <> ""
> > > Set mybook = Workbooks.Open(FNames)
> > >
> > > ' I BELIEVE CODE WOULD GO HERE TO PERFORM STEPS ABOVE
> > >
> > > Sheets("Sheet1").Select
> > > Range("A1").Value = 1000
> > > mybook.Close True
> > > FNames = Dir()
> > > Loop
> > > ChDrive SaveDriveDir
> > > ChDir SaveDriveDir
> > > Application.ScreenUpdating = True
> > > End Sub
> > >
> >
> >
> >