View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Karen53 Karen53 is offline
external usenet poster
 
Posts: 333
Default 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