Solved: Run time error 9 after sheet copy

[JohnERP]

When I run the following code to copy a sheet from one workbook to another I get the run time error 9 about a subscript out of range after the sheet gets added to the recipent workbook. By the way, both Sub routines return the same error even though I'm only showing detail code for one.

I'm a somewhat novice vba Excel coder over the past couple of years.

I appreciate any feedback...John
----------------------------------------------------------------------
[VBA]Private Sub cbtnFix_Click()
Dim filePath, fileToOpen, wkbk, frmPath As String, w1 As Workbook, resp
Set w1 = ActiveWorkbook
frmPath = ActiveSheet.Range("D6").Value
fileToOpen = Application _
.GetOpenFilename("Excel Files (*.xls), *.xls")
If fileToOpen <> False Then

filePath = fileToOpen
Workbooks.Open filePath
wkbk = ActiveWorkbook.Name
End If
resp = MsgBox("Does the PS sheet have data already input?", vbYesNo)
If resp = vbYes Then
PrepPSSheetWithData wkbk, frmPath, w1
End If
If resp = vbNo Then
PrepPSSheetNoData wkbk, frmPath, w1
End If
MsgBox "Complete!"
End Sub

-----------------------

Sub PrepPSSheetWithData(wkbk, frmPath, w1)
Dim c 'column
'add new form
Application.VBE.ActiveVBProject.VBComponents.Import frmPath
'----- copy data from target sheet before deleting -----
'clear temp area Repair sheet 2
w1.Activate
w1.Sheets("Sheet2").Select
w1.Sheets("Sheet2").Range("F3:IV75").ClearContents
Workbooks(wkbk).Activate
Workbooks(wkbk).Sheets("PS").Select
Workbooks(wkbk).Sheets("PS").Range("F3:IV75").Select
Selection.Copy
w1.Activate
w1.Sheets("Sheet2").Select
w1.Sheets("Sheet2").Range("F3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
'----- Delete old sheet, copy new one -----
Workbooks(wkbk).Activate
Workbooks(wkbk).Sheets("PS").Select
ActiveWindow.SelectedSheets.Delete
w1.Activate
w1.Sheets("PS").Select
ActiveSheet.Copy After:=Workbooks(wkbk).Sheets(12) <<error occurs here.

'----- replace old data from temp sheet 2 to new sheet -----
For c = 6 To 33
Select Case c
Case 6, 9, 12, 15, 18, 21, 24, 27, 30, 33
Workbooks(wkbk).Sheets(13).Cells(3, c).Value = w1.Sheets("Sheet2").Cells(3, c).Value
Workbooks(wkbk).Sheets(13).Cells(4, c).Value = w1.Sheets("Sheet2").Cells(4, c).Value
w1.Sheets("Sheet2").Range(Cells(7, c), Cells(75, c + 1)).Select
Selection.Copy
Workbooks(wkbk).Sheets(13).Cells(7, c).Select
ActiveSheet.Paste
Application.CutCopyMode = False


Case Else
GoTo NEXTCOL
End Select
NEXTCOL:
Next c
Workbooks(wkbk).Close True

End Sub[/VBA]

[Norie]

John

Can you post the rest of the code?

[JohnERP]

Thanks...I just reposted.

[Norie]

John

I think what we really need to see is what wkbk and w1 are.

By the way there is no need to activate/select ranges/worksheets/workbooks to work with them.
[vba]
Sub PrepPSSheetWithData(wkbk, frmPath, w1)
Dim c 'column
'add new form
Application.VBE.ActiveVBProject.VBComponents.Import frmPath

'----- copy data from target sheet before deleting -----
'clear temp area Repair sheet 2
w1.Sheets("Sheet2").Range("F3:IV75").ClearContents
Workbooks(wkbk).Sheets("PS").Range("F3:IV75").Copy w1.Sheets("Sheet2").Range("F3")

'----- Delete old sheet, copy new one -----
Workbooks(wkbk).Sheets("PS").Delete
w1.Sheets("PS").Copy After:=Workbooks(wkbk).Sheets(12)
'----- replace old data from temp sheet 2 to new sheet -----
For c = 6 To 33
Select Case c
Case 6, 9, 12, 15, 18, 21, 24, 27, 30, 33
Workbooks(wkbk).Sheets(13).Cells(3, c).Value = w1.Sheets("Sheet2").Cells(3, c).Value
Workbooks(wkbk).Sheets(13).Cells(4, c).Value = w1.Sheets("Sheet2").Cells(4, c).Value
w1.Sheets("Sheet2").Range(Cells(7, c), Cells(75, c + 1)).Copy Workbooks(wkbk).Sheets(13).Cells(7, c)

Case Else
' do nothing
End Select
Next c

Workbooks(wkbk).Close True

End Sub[/vba]

[Cyberdude]

Another possible simplification might be to change:
[vba]
For c = 6 To 33
Select Case c
Case 6, 9, 12, 15, 18, 21, 24, 27, 30, 33
Workbooks(wkbk).Sheets(13).Cells(3, c).Value = w1.Sheets("Sheet2").Cells(3, c).Value
Workbooks(wkbk).Sheets(13).Cells(4, c).Value = w1.Sheets("Sheet2").Cells(4, c).Value
w1.Sheets("Sheet2").Range(Cells(7, c), Cells(75, c + 1)).Copy Workbooks(wkbk).Sheets(13).Cells(7, c)

Case Else
' do nothing
End Select
Next c [/vba] To be:
[vba]For c = 6 To 33 Step 3
Workbooks(wkbk).Sheets(13).Cells(3, c).Value = w1.Sheets("Sheet2").Cells(3, c).Value
Workbooks(wkbk).Sheets(13).Cells(4, c).Value = w1.Sheets("Sheet2").Cells(4, c).Value
w1.Sheets("Sheet2").Range(Cells(7, c), Cells(75, c + 1)).Copy Workbooks(wkbk).Sheets(13).Cells(7, c)
Next c[/vba]

[JohnERP]

Thanks...great ideas for simplification.

[mdmackillop]

A With statement and Worksheet variable might help as well (untested)
[vba]
Set ws = w1.Sheets("Sheet2")
With Workbooks(wkbk).Sheets(13)
For c = 6 To 33 Step 3
.Cells(3, c).Value = ws.Cells(3, c).Value
.Cells(4, c).Value = ws.Cells(4, c).Value
ws.Range(Cells(7, c), Cells(75, c + 1)).Copy .Cells(7, c)
Next c
End With

[/vba]