A commented version
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
'these define where the files are being taken from and being put
'it is assumed that:
' - all excel files in the source folder will be used
' - the target folder is empty
strSourcePath = ThisWorkbook.Path & "\source\"
strTarget = ThisWorkbook.Path & "\target\"
'create an arry of all the excel files
' have to do this as preprocess so that I can test for existence
of
' the target file using the dir function
str = Dir(strSourcePath & "*.xls")
iFiles = 0
Do Until str = ""
iFiles = iFiles + 1
strFiles(iFiles) = str
str = Dir()
Loop
For i = 1 To iFiles 'loop through the source files
strSource = strFiles(i)
Set wkbSource = Workbooks.Open(strSourcePath & strSource)
For Each wks In wkbSource.Worksheets() 'loop through each
worsheet in the source file
str = strTarget & wks.Name & ".xls" 'use the sheet name
to create an output file name
If Dir(str) = "" Then 'see if the file
exists. could do this with an error trap, but it is messier
wks.Copy 'create a new book
Set wkbTarget = ActiveWorkbook
Set wksTarget = ActiveSheet
wkbTarget.SaveAs str
Else
Set wkbTarget = Workbooks().Open(str) ' add sheet to
old book
wks.Copy wkbTarget.Worksheets(1)
Set wksTarget = ActiveSheet
End If
'name sheet with workbook name
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
--
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