View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
tony h[_23_] tony h[_23_] is offline
external usenet poster
 
Posts: 1
Default How to split and consolidate sheets into new workbooks


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