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!
 

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,052
Messages
5,835,148
Members
430,342
Latest member
Sailingexcel

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top