Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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 |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" wrote in message ... 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 |
#3
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
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" wrote in message ... 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 |
#4
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
If you want the change in the master workbook:
ThisWorkbook.ChangeLink Name:="Main.xls", _ NewName:=mybook.Name, Type:= xlExcelLinks -- Regards, Tom Ogilvy "Jason" wrote in message ... 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" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Loop Through All Open Workbooks | Excel Programming | |||
Excel 2003 Workbooks.Open with CorruptLoad=xlRepairFile fails on Excel 5.0/95 file due to Chart, with Error 1004 Method 'Open' of object 'Workbooks' failed | Excel Programming | |||
Loop through all Open workbooks | Excel Programming | |||
Loop through open workbooks | Excel Programming | |||
Can I have a loop to open a set of workbooks get some data, close it one a time. | Excel Programming |