Merge worksheets from multiple files into 1 workbook

Jokada

New Member
Joined
Dec 6, 2005
Messages
12
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 :
Code:
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!
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Jokada

New Member
Joined
Dec 6, 2005
Messages
12
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

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
Replace the existing subroutine with this.
** NB. I have not tested it so try it on a single workbook first **


Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,118,285
Messages
5,571,310
Members
412,381
Latest member
RogerL
Top