View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Thyagaraj Thyagaraj is offline
external usenet poster
 
Posts: 51
Default VBA Code--------!


Norman Jones wrote:
Hi Thyagaraj,

In order to ensure better naming of the summary books worksheets and to
enable indentification of the source of these sheets, try the following
version:

'=============
Public Sub MergeBooks2()
Dim destWb As Workbook
Dim WB As Workbook
Dim SH As Worksheet
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim sstr As String
Dim sStr2 As String
Const sName As String = "My Summary"

sstr = Trim(sName) & " " & Format(Date, "yyyymmdd")

Set destWb = Workbooks.Add(xlWBATWorksheet)
Set SH = destWb.Worksheets(1)
SH.Name = "Summary"

On Error GoTo XIT
Application.ScreenUpdating = False

With destWb
For Each WB In Application.Workbooks
If WB.Name < .Name _
And UCase(WB.Name) < "PERSONAL.XLS" Then
sStr2 = Replace(WB.Name, ".xls", "")
i = i + 1
j = destWb.Sheets.Count
WB.Worksheets.Copy after:=.Sheets(j)
k = destWb.Sheets.Count
For m = j + 1 To k
n = n + 1
destWb.Worksheets(m).Name = sStr2 & " Sh" & CStr(n)
SH.Cells(i, "A").Offset(0, n).Value = WB.Worksheets(n).Name
Next m
SH.Cells(i, "A").Value = WB.Name
j = 0: k = 0: m = 0: n = 0
End If

Next WB
End With

destWb.SaveAs Filename:=sstr, _
FileFormat:=xlWorkbookNormal
XIT:

Application.ScreenUpdating = True

End Sub
'<<=============

---
Regards,
Norman


Dear Norman,

This really great from your side, its working fine...........!


Thank u

regards
Thyagaraj