Need a little help coping a sheet from one workbook to another.

B

Brian S

Below is the code I have. It works in another macro, but not in a new one I
am working on. Not sure where I went wrong. I get the error at this line
wbA.Sheets("C").Copy wbNew.Sheets("PW_CRAD_C")
The error is run time error 9, subscript out of range.

Sub ExportCA_Only()
'
' ExportCA_Only Macro
' Macro recorded 9/9/2002 by rgrisber
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Range("B1").Select
Selection.AutoFilter Field:=2, Criteria1:="=CA", Operator:=xlOr, _
Criteria2:="=WP"
Columns("C:F").Select
Selection.Copy
Worksheets.Add.Name = "C"
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'need to add a sheet to master and then copy the sheet
Dim wbA As Workbook
Dim wbNew As Workbook
With Application
SheetsInWb = .SheetsInNewWorkbook
.SheetsInNewWorkbook = 1
.DisplayAlerts = False
.ScreenUpdating = False
End With
Set wbA = ThisWorkbook
Set wbNew = Workbooks.Add
With wbNew
.SaveAs Filename:="V:\CSPR\PW_CRAD_C.csv"
End With

wbA.Sheets("C").Copy wbNew.Sheets("PW_CRAD_C")
'wbNew.Sheets("Sheet1").Delete
Dim myName As Name
Dim WorkbookLinks As Variant
Dim i As Long
Dim myWB As Excel.Workbook

Set myWB = ActiveWorkbook
....
end sub
 
O

OssieMac

Hi Brian,

I am assuming that you want the copied worksheet name in the new workbook
the same as the new workbook name. If this is correct then try the following.

Note that a space and underscore at the end of a line is a line break in an
otherwise single line of code.

Dim wbA As Workbook
Dim wbNew As Workbook
'Dim SheetsInWb

With Application
'Following line appears superfluous
'SheetsInWb = .SheetsInNewWorkbook

.SheetsInNewWorkbook = 1
.DisplayAlerts = False
.ScreenUpdating = False
End With

Set wbA = ThisWorkbook

Set wbNew = Workbooks.Add

With wbNew
.SaveAs Filename:="V:\CSPR\PW_CRAD_C.csv"
End With

wbA.Sheets("C").Copy _
Before:=wbNew.Sheets(1)

'Rename sheet in new workbook
wbNew.ActiveSheet.Name = "PW_CRAD_C"

'Delete superfluous sheet in new workbook
wbNew.Sheets("Sheet1").Delete
 
D

Dave Peterson

I think you're doing too much work in your extraction:

Option Explicit
Sub ExportCA_Only()

'I think using ThisWorkbook is better (documentation-wise)
'than creating a workbook. But your code looks like it's
'just working with the activesheet
'Dim wbA As Workbook

Dim NewWks As Worksheet
Dim ActWks As Worksheet

Set ActWks = ActiveSheet

Application.ScreenUpdating = False

With ActWks
'remove any existing filter
.AutoFilterMode = False
.Range("B1").EntireColumn.AutoFilter _
Field:=1, _
Criteria1:="CA", _
Operator:=xlOr, _
Criteria2:="WP"

'check to see if there's any data
If .AutoFilter.Range.SpecialCells(xlCellTypeVisible) _
.Cells.Count = 1 Then
'only the header is visible
'don't do the copy???
MsgBox "No details found!"
Else
'create a new workbook with a single sheet
'and set the newwks to that worksheet
Set NewWks = Workbooks.Add(1).Worksheets(1)

.Range("C:F").Cells.SpecialCells(xlCellTypeVisible).Copy
NewWks.Range("A1").PasteSpecial Paste:=xlPasteValues

'remove the header row?
'NewWks.Rows(1).Delete

With NewWks.Parent 'the workbook with the new sheet
On Error Resume Next
Application.DisplayAlerts = False
.SaveAs Filename:="V:\CSPR\PW_CRAD_C.csv"
If Err.Number <> 0 Then
Err.Clear
MsgBox "CSV Save Failed!" _
& vbLf & "Please save it manually"
Else
MsgBox "Saved!"
.Close savechanges:=False 'done with it?
End If
Application.DisplayAlerts = True
On Error Goto 0
End With

End If

'remove the filter
.AutoFilterMode = False
End With

End Sub

ps. you may want to look at how Ron de Bruin and Debra Dalgleish approached the
similar problem of creating new sheets for each unique value in a column.

It's not quite what you're doing today, but it could be what you're doing
tomorrow <vbg>.

Ron de Bruin's EasyFilter addin:
http://www.rondebruin.nl/easyfilter.htm

Or:

Code from Debra Dalgleish's site:
http://www.contextures.com/excelfiles.html

Create New Sheets from Filtered List -- uses an Advanced Filter to create
separate sheet of orders for each sales rep visible in a filtered list; macro
automates the filter. AdvFilterRepFiltered.xls 35 kb

Update Sheets from Master -- uses an Advanced Filter to send data from
Master sheet to individual worksheets -- replaces old data with current.
AdvFilterCity.xls 55 kb
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top