This piece of code takes all the spreadsheets in a lower directory
called SOURCE and creates all the new spreadsheets in a Directory that
must exist called target

root - contains this code
root\source - contains source spreadsheets and nothing else
root\target - all new spreadsheets created here
Option Explicit

Sub reMix()
Dim strSourcePath As String
Dim strSource As String
Dim strTarget As String
Dim strFiles(1 To 50) As String
Dim iFiles As Integer
Dim i As Integer

Dim wkbSource As Workbook
Dim wkbTarget As Workbook

Dim wksSource As Worksheet
Dim wksTarget As Worksheet
Dim wks As Worksheet

Dim str As String

strSourcePath = ThisWorkbook.Path & "\source\"
strTarget = ThisWorkbook.Path & "\target\"

str = Dir(strSourcePath & "*.xls")
iFiles = 0
Do Until str = ""
iFiles = iFiles + 1
strFiles(iFiles) = str
str = Dir()
Loop


For i = 1 To iFiles
strSource = strFiles(i)
Set wkbSource = Workbooks.Open(strSourcePath & strSource)
For Each wks In wkbSource.Worksheets()
str = strTarget & wks.Name & ".xls"
If Dir(str) = "" Then
wks.Copy
Set wkbTarget = ActiveWorkbook
Set wksTarget = ActiveSheet
wkbTarget.SaveAs str
Else
Set wkbTarget = Workbooks().Open(str)
wks.Copy wkbTarget.Worksheets(1)
Set wksTarget = ActiveSheet
End If
wksTarget.Name = Left(wkbSource.Name, Len(wkbSource.Name) -
4)
Set wksTarget = Nothing

wkbTarget.Close xlYes
Set wkbTarget = Nothing
Next
wkbSource.Close xlNo
Set wkbSource = Nothing
Next
MsgBox "done"
End Sub


you should have error trapping etc

hope it helps


--
tony h
------------------------------------------------------------------------
tony h's Profile: http://www.excelforum.com/member.php...o&userid=21074
View this thread: http://www.excelforum.com/showthread...hreadid=503262