Merge worksheets from multiple files into 1 workbook

[Jokada]

Hi guys,

I'm fairly new to Excel programming, but I do have a good knowledge about VBA.

Current situation:

I have about 50 excel files, each for 1 product, containing pricelist/catalogue info. the files are located in different directories.
All these files have 7 worksheets, 1 basic data sheet for price calculation, 1 with pictures & info about the product, 1 with retail prices, 1 with end user prices and then annother 3 pages containing the same info from the previos 3 in annother language.

All these files have linked fields to other excel files (i.e. when i want to change a heading for the pricelists, I only have to change it once.)


Now when i want to print the entire catalogue, i have to open each single file in all those directories.

What I'm trying to do:

To copy the Catalogue sheets / retail prices / End customer prices for each product into 1 workbook.
Annother requirement is that it only copies the actual values and pictures in the sheets, NOT the formulas/linked sheet data.

Actually this is the same function if you rightclick a sheet and copy it to annother workbook but then without the formulas/linked values, but the actual values.

I've noticed for this to work all your Excel files need to be in the same directory.
I've written a vbs script that copies all Excel files from all Subdirectories to a given directory using Excel. (So that the linked fields are updated as well)

This is the script :

mypath="H:\company\prices\lists\Standard prices"
copypath="H:\company\prices\lists\01.2006"

Set filesystem =CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")
Set FSO = CreateObject("Scripting.FileSystemObject")

ShowSubfolders FSO.GetFolder(mypath)
Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders
		strProp = Subfolder.path
	    Set folder = filesystem.GetFolder(strProp)
		Set filecollection = folder.Files
	    
		For Each file in filecollection
		
		    if instr(file.Name, "06") then
			    filename = strprop & "\" & file.Name
				objExcel.Visible = True
				objExcel.Workbooks.open filename
				objExcel.ActiveWorkbook.SaveAs copypath & "\" & file.name
				objExcel.Application.Quit
				'Set objExcel = Nothing
			end if
		Next
    ShowSubFolders Subfolder
    Next
End Sub

I was wondering if you guys could help me out on this one.
It would save me tonnes of time!!

Thanks in advance!

 

[BrianB]

This is my method, but you could use the same basic structure with yours :-

http://www.mrexcel.com/board2/viewtopic.php?t=145246&highlight=

 

[Jokada]

Hi,

This actually works! only one big desadvantage, the layout with the pictures and background color is compleetly messed up.


Is there a way to copy only 1 sheet from a workbook to another workbook with the "copy sheet method" or somthing similar?

Thx!

 

[BrianB]

Replace the existing subroutine with this.
** NB. I have not tested it so try it on a single workbook first **

Private Sub Transfer_data()
    Workbooks.Open FileName:=FromBook
    '- last worksheet in ToBook
    lastsheet = Workbooks(ToBook).Worksheets.Count
    '- copy sheet across
    ActiveWorkbook.Worksheets("Sheet1").Copy _
        after:=Workbooks(ToBook).Worksheets(lastsheet)
    '- cells to values
    ActiveSheet.UsedRange.Copy
    ActiveSheet.UsedRange.PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    Workbooks(FromBook).Close savechanges:=False
End Sub