JohnERP
08-27-2006, 07:04 AM
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
----------------------------------------------------------------------
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
I'm a somewhat novice vba Excel coder over the past couple of years.
I appreciate any feedback...John
----------------------------------------------------------------------
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