ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Range of Object Worksheet failed (https://www.excelbanter.com/excel-programming/407849-range-object-worksheet-failed.html)

Karen53

Range of Object Worksheet failed
 
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

--
Thanks for your help.
Karen53

Dave Peterson

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

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

Karen53 wrote:

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

--
Thanks for your help.
Karen53


--

Dave Peterson

Karen53

Range of Object Worksheet failed
 
Duuuuuuuuhhhh!!!

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


"Dave Peterson" wrote:

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

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

Karen53 wrote:

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

--
Thanks for your help.
Karen53


--

Dave Peterson



All times are GMT +1. The time now is 06:51 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com