Copy contents of sheets in another workbook?

[thommo41]

Hi,
I have a scenario where a user is complaining about a repetative task where errors often occur. He wants to know if it can be automated.
It should be very simply. The file that would be open, and active on the users Excel session would have named sheets. There would be a file in the same folder that can be named accordingly to make it simple, that contains sheets of the same name.

Basically, I need a VBA routine that will copy the contents of named sheets from one workbook (preferably not opened on the users excel session), into the relevant sheets on the current open workbook.

I can do this easily enough if both workbooks are open, just recording a macro will do the basics of selecting a sheet in one book, copying, selecting the other sheet in the other book, and pasting. Repeating for each sheet.

But can I do this without the book being opened? And more important, how do I optimise the code so it's not simply copy/paste, looped over and over for each named sheet?

Thanks in advance
ALan

 

[thommo41]

OK, even with the book open, when I do the copy/paste routine for each sheet, it retains the link back to the original workbook. I need to copy values, formatting and formulas, but not link back to the file I copied from. Any ideas?

 

[Datsmart]

I am playing with some code to try and help you with your request.
Can you post a sample of the code you have so far. That way my test code can be built to your needs.
Also, please post a sample of your formulas that you want to not link back to the source.

 

[thommo41]

Thank you!
Some example formulas that are typical of the sheets, they reference values from another sheet in the book...

=HLOOKUP(J9,S.O.E!$G$59:$R$61,2)
=S.O.E!$V$60

The code I have now...

Sub copyauto()
Dim window1, window2 As String
window1 = ActiveWorkbook.Name
window2 = (Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)) & " - Auto.xls"

For Each ws In Worksheets(Array("CODE 500", "CODE 600", "Instruments", "IO List", "AutoMHrs", "Autom Installation Est"))
ws.UsedRange.ClearContents
Next ws

Application.ScreenUpdating = False ' Turn off screen movements etc to appear to run in background
Application.DisplayAlerts = False ' Turn off screen warnings

Windows(window2).Activate
Sheets("CODE 500").Cells.Copy
Windows(window1).Activate
Sheets("CODE 500").Paste

Windows(window2).Activate
Sheets("CODE 600").Cells.Copy
Windows(window1).Activate
Sheets("CODE 600").Paste

Windows(window2).Activate
Sheets("Instruments").Cells.Copy
Windows(window1).Activate
Sheets("Instruments").Paste

Windows(window2).Activate
Sheets("IO List").Cells.Copy
Windows(window1).Activate
Sheets("IO List").Paste

Windows(window2).Activate
Sheets("AutoMHrs").Cells.Copy
Windows(window1).Activate
Sheets("AutoMHrs").Paste

Windows(window2).Activate
Sheets("Autom Installation Est").Cells.Copy
Windows(window1).Activate
Sheets("Autom Installation Est").Paste

Application.CutCopyMode = False

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Thanks in advance, Alan

 

[Datsmart]

Used your code, removed "Activate"s to speed it up.
Added code to remove workbook reference from Formulas.

Sub copyauto2()
'Assign variables
    WB1 = ActiveWorkbook.Name
    WB2 = (Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4)) & " - Auto.xls"
'Assign variable for formula replacement
    WBname = "[" & WB2 & "]"
'Copy each WorkSheet
    For Each ws In Worksheets(Array("CODE 500", "CODE 600", "Instruments", "IO List", "AutoMHrs", "Autom Installation Est"))
        With ws
            'Clear old Data in worksheet
            ws.UsedRange.ClearContents
            Workbooks(WB2).Sheets(ws.Name).UsedRange.Copy Workbooks(WB1).Sheets(ws.Name).Range("A1")
            'Clear old filename reference from any formulas
            On Error Resume Next
            Cells.Replace what:=WBname, replacement:=""
        End With
    Next ws
End Sub

Code assumes that both workbooks are Open and Source WorkBook name is correct.

 

[thommo41]

Excellent, thank you!
I had to change one line, for the replace text to work...
Sheets(ws.Name).Cells.Replace what:=wbname, replacement:=""

Otherwise perfect! Thanks again, Alan