PDA

View Full Version : Solved: Sheets.Copy won't work



lynnnow
10-16-2010, 08:30 AM
Hi All, This is my code:


Sub ReportCumulator()
Dim ToReport As Variant
Dim FromReport As Variant

ToReport = Application _
.GetOpenFilename("All Microsoft Office Excel Files (*.xls), *.xls", _
Title:="...::: Lynx's Corner :::...")

Application.ScreenUpdating = False
If ToReport <> False Then
Workbooks.Open ToReport
ReTryOpen:
FromReport = Application _
.GetOpenFilename("All Microsoft Office Excel Files (*.xls), *.xls", _
Title:="...::: Lynx's Corner :::...")
If FromReport <> False Then
Workbooks.Open FromReport
Else: GoTo ReTryOpen
End If
Else
Application.ScreenUpdating = True
Exit Sub
End If

Worksheets(1).Copy After:=Workbooks(ToReport).Worksheets(Workbooks(ToReport).Sheets.Count)
Application.ScreenUpdating = True
End Sub

The sheet won't copy. The source file has only one sheet and the target file can have more than one sheet. I've done this before and it has worked, but it refuses to cooperate now. The error I am getting is a "out of subscript" error. Any clues on how to get around this? I've posted this in Mr. Excel http://www.mrexcel.com/forum/showthread.php?p=2478360#post2478360

Zack Barresse
10-16-2010, 10:06 AM
Perhaps try setting the workbooks as variables. Not sure, so I guessed from looking at your code which was the copy and which was the destination...

Option Explicit

Sub ReportCumulator()
Dim wbCopy As Workbook, wbDest As Workbook
Dim wsCopy As Worksheet, wsDest As Worksheet
Dim sName As String
Dim bDestOpen As Boolean, bCopyOpen As Boolean
Dim ToReport As Variant
Dim FromReport As Variant
ToReport = Application.GetOpenFilename("All Microsoft Office Excel Files (*.xls), *.xls", Title:="...::: Lynx's Corner :::...")
If TypeName(ToReport) = "Boolean" Then
'user cancelled
Exit Sub
End If
Application.ScreenUpdating = False
sName = Right(ToReport, Len(ToReport) - InStrRev(ToReport, Application.PathSeparator))
If ISWBOPEN(sName) = True Then
Set wbDest = Workbooks(sName)
bDestOpen = True
Else
Set wbDest = Workbooks.Open(ToReport)
bDestOpen = False
End If
ReTryOpen:
FromReport = Application.GetOpenFilename("All Microsoft Office Excel Files (*.xls), *.xls", Title:="...::: Lynx's Corner :::...")
If TypeName(FromReport) = "Boolean" Then GoTo ReTryOpen
sName = Right(FromReport, Len(FromReport) - InStrRev(FromReport, Application.PathSeparator))
If ISWBOPEN(sName) = True Then
Set wbCopy = Workbooks(sName)
bCopyOpen = True
Else
Set wbCopy = Workbooks.Open(FromReport)
bCopyOpen = False
End If
wbCopy.Sheets(1).Copy wbDest.Sheets(wbDest.Sheets.Count)
Application.ScreenUpdating = True
If bDestOpen = False Then wbDest.Close True
If bCopyOpen = False Then wbCopy.Close False
End Sub

Function ISWBOPEN(sWbName As String) As Boolean
On Error Resume Next
ISWBOPEN = Len(Workbooks(sWbName).Name)
On Error GoTo 0
End Function

lynnnow
10-16-2010, 06:27 PM
Thanks Zack. Will compare codes on monday and see where the problem is.

mbarron
10-16-2010, 07:01 PM
I got this version to work.

Sub ReportCumulator()
Dim ToR As Variant, ToReport As Workbook
Dim FrR As Variant, FromReport As Workbook

ToR = Application _
.GetOpenFilename("All Microsoft Office Excel Files (*.xls), *.xls", _
Title:="...::: Lynx's Corner :::...")

Application.ScreenUpdating = False
If ToR <> False Then
Set ToReport = Workbooks.Open(ToR)
ReTryOpen:
FrR = Application _
.GetOpenFilename("All Microsoft Office Excel Files (*.xls), *.xls", _
Title:="...::: Lynx's Corner :::...")
If FrR <> False Then
Set FromReport = Workbooks.Open(FrR)
Else: GoTo ReTryOpen
End If
Else
Application.ScreenUpdating = True
Exit Sub
End If

Worksheets(1).Copy After:=ToReport.Worksheets(ToReport.Sheets.Count)
Application.ScreenUpdating = True
End Sub

lynnnow
10-17-2010, 07:08 AM
Zack, I love what your code does, simple with error handling.

Barron, thank you for you help. Works superb.

Need some more help now.

Since these files (sheets) are being cumulated datewise, there is a chance that the cumulation will not be done serially, viz., the user may randomly just pick a file to import and the order of the sheets will not be in ascending order, viz., 1, 2, 3, etc. There can also be instances where a particular date's sheet has not been created (usually a weekend, but the report being created depends on the data in the report and I can't predict it's availability).

My question now is, after the cumulation of sheets is done, is there a way to check the order of the sheets and rearrange the order if the sheets are not in datewise order?

lynnnow
10-17-2010, 07:58 AM
Hi guys,

Tried a bit on my own and this is what I have come up with.

Sub sortsheets()
On Error Resume Next
ReStart:
For i = 1 To Sheets.Count
If Sheets(i).Name = "Cumulative" Then
Sheets("Cumulative").Move After:=ActiveWorkbook.Sheets.Count
Exit Sub
Else
If Val(Sheets(i).Name) > Val(Sheets(i + 1).Name) Then
Sheets(i).Move After:=Sheets(i + 1)
GoTo ReStart
End If
End If
Next

End Sub

However, the "Cumulative" sheet always happens to come to the first position after the code is run. I have used ActiveWorkbook in the move statement for now since I have tried it as an individual module instead of being part of the main module. I will eventually use the variable set for the target file.

Some help guys...

lynnnow
10-17-2010, 08:05 AM
Ok guys, solved it. Don't bother. Just a block in my thinking....

Here's it updated:

ReStart:
For i = 1 To Sheets.Count
If Sheets(i).Name = "Cumulative" Then
Sheets("Cumulative").Move After:=Worksheets(Sheets.Count)
Exit Sub
Else
If Val(Sheets(i).Name) > Val(Sheets(i + 1).Name) Then
Sheets(i).Move After:=Sheets(i + 1)
GoTo ReStart
End If
End If
Next

Zack Barresse
10-17-2010, 08:13 AM
Also look here: http://www.vbaexpress.com/kb/getarticle.php?kb_id=72