Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...

MS Office Forum / Excel / New Users / November 2006

Tip: Looking for answers? Try searching our database.

copying wkshts from one workbook to another

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
andrea - 21 Nov 2006 22:31 GMT
I am having trouble getting my code for copying worksheets from one
workbook to another to work.  Here is my code in its entirety:

Sub Save_Report()

Dim rngAllFiles(), rngSelectFiles(), m, fileSaveName, wkshtName As
Variant
Dim a, s, i As Integer
Dim newBook As Object

rngAllFiles = Array("1 Cover.xls", "2 Table of Contents.xls", "3 Top
Ten.xls", "4 FX Impact.xls", "5A MTD IS.xls", "5B QTD IS.xls", "5C YTD
IS.xls", "6 Sales-Internal.xls", "7 Sales-WS.xls", "8A MTD GM.xls", "8B
QTD GM.xls", "8C YTD GM.xls", "9 Op Exp by Location.xls", "10 RD Exp by
Month.xls", "11 AZ versus Pr. Year.xls", "12 AZ versus Budgdt.xls", "13
Payroll by BU.xls", "14 PR Tax by BU.xls", "15 Supplies by BU.xls", "16
Catalog by BU.xls", "17 R&M by BU.xls", "18 A&P by BU.xls", "19 T&E
BU.xls", "20 LP&C BU.xls", "21 R&H by BU.xls", "22 Headcount.xls", "23
Payroll by Location.xls", "24 Payroll versus Pr. Year.xls", "25 Payroll
versus Budget.xls", "26 BS.xls", "27 AR.xls", "28 Inventory.xls", "29
Cap Ex.xls")
a = 0
s = 0
i = Workbooks("Save_Final_Op_Summary.xls").Worksheets("Save Final
Report").Cells(40, 2)

If i = 1 Then
   ReDim rngSelectFiles(i)
Else: ReDim rngSelectFiles(i - 1)
End If

For r = 7 To 39
   If ActiveSheet.Cells(r, 2) = "True" Then
       rngSelectFiles(s) = rngAllFiles(a)
       s = s + 1
   Else: End If
   a = a + 1
Next r

Set newBook = Workbooks.Add
fileSaveName = Application.GetSaveAsFilename("newBook", "Microsoft
Excel Workbook (*.xls), *.xls")
newBook.SaveAs Filename:=fileSaveName
For Each m In rngSelectFiles
   Workbooks.Open Filename:=m
   Workbooks(m).Sheets(1).Copy
before:=Workbooks(fileSaveName).Sheets(1)
   fileSaveName.Activate
   ActiveSheet.UsedRange.PasteSpecial Paste:=xlPasteValues
Next m

End Sub

I am getting a subscript out of range error on this line
"Workbooks(m).Sheets(1).Copy
before:=Workbooks(fileSaveName).Sheets(1)".

Can anyone help me with this?

Thx,
wisccal@googlemail.com - 22 Nov 2006 08:12 GMT
The problem is that the function getSaveAsFileName returns a full path
like "c:\myFile.xls". The Workbook Collection's index can only be used
with file names, though. In your case Workbooks("myFile.xls"). The
following should fix this problem

Workbooks(Mid(fileSaveName, InStrRev(fileSaveName, "\") + 1)).Sheets(1)

InStrRev looks up the last occurrence of the file separator "\", and
Mid returns a substring from that position + 1 to fileSaveName's end.

Regards,
Steve

Also, you are referring to
andrea schrieb:

> I am having trouble getting my code for copying worksheets from one
> workbook to another to work.  Here is my code in its entirety:
[quoted text clipped - 56 lines]
>
> Thx,
andrea - 22 Nov 2006 15:50 GMT
Thanks!  That did it and the macro works great now.

> The problem is that the function getSaveAsFileName returns a full path
> like "c:\myFile.xls". The Workbook Collection's index can only be used
[quoted text clipped - 72 lines]
> >
> > Thx,
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage

Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.