I have 6 Workbooks with 60 worksheets in each.
Each of the 6 Workbooks has the same number of worksheets with the sam
name. One workbook is sales for companys 1-60,
one is emloyment data for companys 1-60, etc.
I'd like to end up with 60 workbooks with 6 worksheets in each.
One additional wrench is that the 60 worksheets are named the
smae in each of the 6 workbooks

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com

To copy a sheet from one book to another is easy

Workbooks("Book1").Sheets("Sheet1").Cop
Befo=Workbooks("Book2").Sheets(1)

but I gather what you really want to do is take the data from eac
sheet for company 1 and add it to the relevant sheet in book 1 wrigh
the way through to book 60 for company 60

if this is the case then can you supply details of hw you identify wha
entry belongs to which company on each shee

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com

Mudraker,
In Workbook1, Sheets 1..60 are named Company1..Company60
In Workbook2, Sheets 1..60 are named the same: Company1..Company60
In Workbook3, 4,5,&6 it's the same.

The Result should be Company1.xls with 6 sheets each named Company1 +
some unique counter to ensure sheets don't end up with the same name.


------------------------------------------------
~~ Message posted from http://www.ExcelTip.com/
~~View and post usenet messages directly from http://www.ExcelForum.com/

Not perfect but i beleive it will give you a step in the righ
direction


Sub teSt()
Dim bSheet As Boolean

Dim NewWB(1 To 60) As String
Dim OldWB(1 To 6) As String
Dim OldWs As Worksheet
Dim NewWS As Worksheet

Dim sPath As String
Dim sFile As String
Dim sFname As String
Dim wsInd As Integer
Dim wsName As String

sPath = "h:\test\"


'create New Workbooks
For i = LBound(NewWB) To UBound(NewWB) Step 1
sFname = "Comp" & i & ".xls"
sFile = sPath & sFname
If Dir(sFile) = "" Then
Workbooks.Add
ActiveWorkbook.SaveAs FileName:=sFile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:=""
ReadOnlyRecommended:=False _
, CreateBackup:=False
Else
Workbooks.Open FileName:=sFile
End If
NewWB(i) = ActiveWorkbook.Name
Next i

' copy sheets from old books to new books
For i = LBound(OldWB) To UBound(OldWB)
sFname = "Comp" & i & ".xls"
sFile = sPath & sFname
If Dir(sFile) < "" Then
Workbooks.Open FileName:=sFile
OldWB(i) = ActiveWorkbook.Name
For Each OldWs In Worksheets
wsInd = OldWs.Index
wsName = OldWs.Name
bSheet = False
For Each NewWS In Workbooks(NewWB(wsInd)).Worksheets
' look for sheet with same name in new workbook
If NewWS.Name = wsName Then
bSheet = True
Exit For
End If
Next NewWS
If bSheet = False Then
Sheets(wsInd).Cop
Befo=Workbooks(NewWB(wsInd)).Sheets(1)
End If
Next OldWs
End If
Next i
End Su

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com

Many thanks

-----------------------------------------------
~~ Message posted from http://www.ExcelTip.com
~~View and post usenet messages directly from http://www.ExcelForum.com