Range of Object Worksheet failed

K

Karen53

Hi,

I am getting a Range of Object Worksheet failed on the line where I set the
"TaxLineItems" range. The others, "AMLineItemsExterior"and
"AMLIneItemsInterior" set with no problem. Only the Tax named range errors
out. Why?

Sub wkbookCreate()

Dim wbkCopyFrom As Workbook
Dim wbkCopyTo As Workbook
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim FromwbkName As String
Dim FromPath As String
Dim FromwbkPath As Variant
Dim wbkCopyFromName As String 'for opening file
Dim LusedRow As Long

Set wbkCopyTo = ThisWorkbook

FromwbkPath = Application.GetOpenFilename(Filefilter:="Excel Files,*.xls")

If FromwbkPath = False Then
Exit Sub 'user hit cancel
End If

Call GetNamePath(FromwbkName, FromPath, FromwbkPath)

'just the filename
wbkCopyFromName = Mid(FromwbkPath, InStrRev(FromwbkPath, "\") + 1)

On Error Resume Next

Set wbkCopyFrom = Workbooks(wbkCopyFromName)
On Error GoTo 0

If wbkCopyFrom Is Nothing Then
Set wbkCopyFrom = Workbooks.Open(FromwbkPath)
On Error GoTo 0
If wbkCopyFrom Is Nothing Then
MsgBox "Cannot find originating file--in use?"
Exit Sub
Else
Application.ScreenUpdating = False

wbkCopyTo.Activate

wbkCopyTo.Sheets((Replace(Tablespg.Name, "'", "''"))).Unprotect
Password:=([MyPassword])

'Pool lists
'CAM
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("J4:J21")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("J4:J21")
rngCopyTo.Value = rngCopyFrom.Value

'Tax
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("M4:M21")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("M4:M21")
rngCopyTo.Value = rngCopyFrom.Value

'Line Items
'Exterior
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("U4:X304")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("U4:X304")
rngCopyTo.Value = rngCopyFrom.Value

'set the Exterior Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "U").End(xlUp).Row
Tablespg.Range("U4:X" & LusedRow).Name = "CAMLineItemsExterior"
LusedRow = 0

'Interior
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AA4:AD304")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AA4:AD304")
rngCopyTo.Value = rngCopyFrom.Value

'set the Interior Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "AA").End(xlUp).Row
Tablespg.Range("AA4:AD" & LusedRow).Name = "CAMLineItemsInterior"
LusedRow = 0

'Tax
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AF4:AI154")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AF4:AI154")
rngCopyTo.Value = rngCopyFrom.Value

'set the Tax Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "AF").End(xlUp).Row
Tablespg.Range("AF:AI" & LusedRow).Name = "TaxLineItems" 'this
is where it errors
LusedRow = 0

wbkCopyTo.Sheets(Replace(Tablespg.Name, "'", "''")).Protect
Password:=([MyPassword])

wbkCopyFrom.Close SaveChanges:=False

wbkCopyTo.SaveAs Filename:=FromPath & FromwbkName & " Final.xls"

Application.ScreenUpdating = True

MsgBox "Workbook Structure has been copied."

End If
End If

End Sub
 
D

Dave Peterson

Tablespg.Range("AF:AI" & LusedRow)
What row did you want to use in column AF?

Row 1?
Tablespg.Range("AF1:AI" & LusedRow)
Hi,

I am getting a Range of Object Worksheet failed on the line where I set the
"TaxLineItems" range. The others, "AMLineItemsExterior"and
"AMLIneItemsInterior" set with no problem. Only the Tax named range errors
out. Why?

Sub wkbookCreate()

Dim wbkCopyFrom As Workbook
Dim wbkCopyTo As Workbook
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim FromwbkName As String
Dim FromPath As String
Dim FromwbkPath As Variant
Dim wbkCopyFromName As String 'for opening file
Dim LusedRow As Long

Set wbkCopyTo = ThisWorkbook

FromwbkPath = Application.GetOpenFilename(Filefilter:="Excel Files,*.xls")

If FromwbkPath = False Then
Exit Sub 'user hit cancel
End If

Call GetNamePath(FromwbkName, FromPath, FromwbkPath)

'just the filename
wbkCopyFromName = Mid(FromwbkPath, InStrRev(FromwbkPath, "\") + 1)

On Error Resume Next

Set wbkCopyFrom = Workbooks(wbkCopyFromName)
On Error GoTo 0

If wbkCopyFrom Is Nothing Then
Set wbkCopyFrom = Workbooks.Open(FromwbkPath)
On Error GoTo 0
If wbkCopyFrom Is Nothing Then
MsgBox "Cannot find originating file--in use?"
Exit Sub
Else
Application.ScreenUpdating = False

wbkCopyTo.Activate

wbkCopyTo.Sheets((Replace(Tablespg.Name, "'", "''"))).Unprotect
Password:=([MyPassword])

'Pool lists
'CAM
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("J4:J21")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("J4:J21")
rngCopyTo.Value = rngCopyFrom.Value

'Tax
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("M4:M21")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("M4:M21")
rngCopyTo.Value = rngCopyFrom.Value

'Line Items
'Exterior
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("U4:X304")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("U4:X304")
rngCopyTo.Value = rngCopyFrom.Value

'set the Exterior Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "U").End(xlUp).Row
Tablespg.Range("U4:X" & LusedRow).Name = "CAMLineItemsExterior"
LusedRow = 0

'Interior
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AA4:AD304")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AA4:AD304")
rngCopyTo.Value = rngCopyFrom.Value

'set the Interior Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "AA").End(xlUp).Row
Tablespg.Range("AA4:AD" & LusedRow).Name = "CAMLineItemsInterior"
LusedRow = 0

'Tax
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AF4:AI154")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AF4:AI154")
rngCopyTo.Value = rngCopyFrom.Value

'set the Tax Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "AF").End(xlUp).Row
Tablespg.Range("AF:AI" & LusedRow).Name = "TaxLineItems" 'this
is where it errors
LusedRow = 0

wbkCopyTo.Sheets(Replace(Tablespg.Name, "'", "''")).Protect
Password:=([MyPassword])

wbkCopyFrom.Close SaveChanges:=False

wbkCopyTo.SaveAs Filename:=FromPath & FromwbkName & " Final.xls"

Application.ScreenUpdating = True

MsgBox "Workbook Structure has been copied."

End If
End If

End Sub
 
K

Karen53

Duuuuuuuuhhhh!!!

Thank you, Dave. I think I'm looking at this too much and am beyond seeing.
--
Thanks for your help.
Karen53


Dave Peterson said:
Tablespg.Range("AF:AI" & LusedRow)
What row did you want to use in column AF?

Row 1?
Tablespg.Range("AF1:AI" & LusedRow)
Hi,

I am getting a Range of Object Worksheet failed on the line where I set the
"TaxLineItems" range. The others, "AMLineItemsExterior"and
"AMLIneItemsInterior" set with no problem. Only the Tax named range errors
out. Why?

Sub wkbookCreate()

Dim wbkCopyFrom As Workbook
Dim wbkCopyTo As Workbook
Dim rngCopyFrom As Range
Dim rngCopyTo As Range
Dim FromwbkName As String
Dim FromPath As String
Dim FromwbkPath As Variant
Dim wbkCopyFromName As String 'for opening file
Dim LusedRow As Long

Set wbkCopyTo = ThisWorkbook

FromwbkPath = Application.GetOpenFilename(Filefilter:="Excel Files,*.xls")

If FromwbkPath = False Then
Exit Sub 'user hit cancel
End If

Call GetNamePath(FromwbkName, FromPath, FromwbkPath)

'just the filename
wbkCopyFromName = Mid(FromwbkPath, InStrRev(FromwbkPath, "\") + 1)

On Error Resume Next

Set wbkCopyFrom = Workbooks(wbkCopyFromName)
On Error GoTo 0

If wbkCopyFrom Is Nothing Then
Set wbkCopyFrom = Workbooks.Open(FromwbkPath)
On Error GoTo 0
If wbkCopyFrom Is Nothing Then
MsgBox "Cannot find originating file--in use?"
Exit Sub
Else
Application.ScreenUpdating = False

wbkCopyTo.Activate

wbkCopyTo.Sheets((Replace(Tablespg.Name, "'", "''"))).Unprotect
Password:=([MyPassword])

'Pool lists
'CAM
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("J4:J21")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("J4:J21")
rngCopyTo.Value = rngCopyFrom.Value

'Tax
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("M4:M21")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("M4:M21")
rngCopyTo.Value = rngCopyFrom.Value

'Line Items
'Exterior
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("U4:X304")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("U4:X304")
rngCopyTo.Value = rngCopyFrom.Value

'set the Exterior Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "U").End(xlUp).Row
Tablespg.Range("U4:X" & LusedRow).Name = "CAMLineItemsExterior"
LusedRow = 0

'Interior
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AA4:AD304")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AA4:AD304")
rngCopyTo.Value = rngCopyFrom.Value

'set the Interior Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "AA").End(xlUp).Row
Tablespg.Range("AA4:AD" & LusedRow).Name = "CAMLineItemsInterior"
LusedRow = 0

'Tax
Set rngCopyFrom = wbkCopyFrom.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AF4:AI154")
Set rngCopyTo = wbkCopyTo.Sheets(Replace(Tablespg.Name, "'",
"''")).Range("AF4:AI154")
rngCopyTo.Value = rngCopyFrom.Value

'set the Tax Line Items Named Range
LusedRow = Tablespg.Cells(Rows.Count, "AF").End(xlUp).Row
Tablespg.Range("AF:AI" & LusedRow).Name = "TaxLineItems" 'this
is where it errors
LusedRow = 0

wbkCopyTo.Sheets(Replace(Tablespg.Name, "'", "''")).Protect
Password:=([MyPassword])

wbkCopyFrom.Close SaveChanges:=False

wbkCopyTo.SaveAs Filename:=FromPath & FromwbkName & " Final.xls"

Application.ScreenUpdating = True

MsgBox "Workbook Structure has been copied."

End If
End If

End Sub
 

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