Excel - Macro to copy a worksheet to other workbooks 1

[xtendscott]

I currently have 100+ workbooks (seperate excel files but all the same basic workbook) and wanting to update them to include a new worksheet that adds additional calculations on some of the data within the current workbook.

Copy worksheet from A.xls to b.xls, c.xls, d.xls, ect.(within a specific folder prefered).

Is this possible? If so where to start to make this happen?

Thanks.



xtendscott
Home Improvement Watch | Cryosurgery | Walla Walla Portal | Walla Walla Martial Arts

 

[AnotherHiggins]

Use your macro recorder (Tools > Macro > Record New Macro) to get code that copies a worksheet to another workbook. Once you have that code, stick in the middle of something like this:

sub LoopThroughFilesInAFolder
strOrigFile = ActiveWorkbook.name

Dim fs
Set fs = Application.FileSearch

With fs
    .LookIn = MyPath
    .Filename = "*.xls"
    .Execute
        For i = 1 To .FoundFiles.Count
            Workbooks.Open .FoundFiles(i)
            strCurrentWBName = ActiveWorkbook.name
                'copy and paste whatever here
            Windows(strCurrentWBName).Save
            Windows(strCurrentWBName).Close
        Next i
End With
Set fs = Nothing
End Sub

Post back f you need help cleaning up the code you get out of the Macro Recorder.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[xtendscott]

This is what I was able to get and had to "replace" the prior FILE name with "" to reference the current FILE.

How would you insert your code into this?

Sub Scott_Test()

    Sheets("Export_Data").Select
    Sheets("Export_Data").Copy After:=Workbooks("tempSheet.xls").Sheets(35)
    Cells.Replace What:="[mywksheet.xls]", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("B19").Select
    ActiveWorkbook.Save
    ActiveWorkbook.Close
End Sub

Your assistance is much apprciated.

Scott

xtendscott
Home Improvement Watch | Cryosurgery | Walla Walla Portal | Walla Walla Martial Arts

 

[AnotherHiggins]

Adding the code you captured to copy a sheet to another workbook to the code I provided earlier will yield something like this:

Sub LoopThroughFilesInAFolder()
strOrigFile = ActiveWorkbook.Name

Dim fs
Set fs = Application.FileSearch

With fs
    .LookIn = "K:\Data Analyst\Testing Grounds" '"C:\Your\Path\Here"
    .Filename = "*.xls"
    .Execute
        For i = 1 To .FoundFiles.Count
            Workbooks.Open .FoundFiles(i)
            strCurrentWBName = ActiveWorkbook.Name
                Workbooks(strOrigFile).Sheets("Export_Data").Copy _
                After:=Workbooks(strCurrentWBName).Sheets(35)
            Workbooks(strCurrentWBName).Save
            Windows(strCurrentWBName).Close
        Next i
End With
Set fs = Nothing
End Sub

Note: Will you have at least 35 sheets in all of the target workbooks? If not, After:=Workbooks(strCurrentWBName).Sheets(35) is going to error out on you. If you want the added sheet to ALWAYS be last, regardless of how many sheets a target workbook might have, then replace that line of code with this:

Workbooks(strOrigFile).Sheets("Export_Data").Copy _
After:=Workbooks(strCurrentWBName).Sheets(35)

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[xtendscott]

When I use your code, I get a "Compile Error: Can't find project or library".

Looking that up in Google, it could be related to a missing "Reference", I do have one that appears to be empty called "Reference to CBDevkit.xla" I don't know what that is or how to get rid of it if it is related.

Do I need any library's to make this work?



xtendscott
Home Improvement Watch | Cryosurgery | Walla Walla Portal | Walla Walla Martial Arts

 

[AnotherHiggins]

In the VBEditor, go to Tools > references.

I'm pretty sure that you need to have the following enabled in order to use FileSearch:
Microsoft Office XX Object Library

If you still have no joy, post back.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[xtendscott]

OK, under References I have:
[x] Visual Basic For Application
[x] Microsoft Excel 11..0 Object library
[x] OLE Automation
[x] Microsoft Office 11.0 Object library

I tried a more manual way to update a file and then running a "Personal Macro" and was having similar issues. I finally found what worked by declaring the variables differently. Then took that process and modified your script.

I am not sure why the other code would not work properly, we are using Excel 2003, but here is what I got to work.

Sub LoopThroughFilesInAFolder()
Dim strOrigFile As Workbook
Dim strCurrentWBName As Workbook
Dim fs
Dim i

Set strOrigFile = ActiveWorkbook
Set fs = Application.FileSearch

With fs
    .LookIn = "H:\macroTest" '"C:\Your\Path\Here"
    .Filename = "*.xls"
    .Execute
        For i = 1 To .FoundFiles.Count
            Workbooks.Open .FoundFiles(i)
            Set strCurrentWBName = ActiveWorkbook
                strOrigFile.Sheets("Export_Data").Copy After:=strCurrentWBName.Sheets(35)
            Sheets("Model ID").Select
            strCurrentWBName.Save
            strCurrentWBName.Close
        Next i
      
End With
Set fs = Nothing
End Sub

Thank you very much for your help.

xtendscott
Home Improvement Watch | Cryosurgery | Walla Walla Portal | Walla Walla Martial Arts