View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Mike H. Mike H. is offline
external usenet poster
 
Posts: 471
Default Copy worksheet with named ranges to new workbook and keep names in

This is one way that would work:
Obviously, you'd have to adjust named range names and sheet names as
appropriate.


Option Explicit
Option Base 1

Sub Doit()
Dim MyEntries As String
Dim OrigEntries As String
Dim PasteRange As Range
Dim toprange As Variant
Dim rowcount As Long
Dim ColCount As Long
Dim TopRow As Long
Dim TOpCol As Long

OrigEntries = ActiveWorkbook.Name
Range("area1").Select
Selection.Copy
Workbooks.Add Template:="Workbook"
MyEntries = ActiveWorkbook.Name
Sheets("sheet1").Select
ActiveSheet.Paste
Let TopRow = ActiveCell.Row
Let TOpCol = ActiveCell.Column
Let rowcount = Selection.Rows.Count
Let ColCount = Selection.Columns.Count
ActiveWorkbook.Names.Add Name:="area1", RefersToR1C1:="=Sheet1!" & "R" &
TopRow & "C" & TOpCol & ":R" & rowcount - TopRow + 1 & "C" & ColCount -
TOpCol + 1

Windows(OrigEntries).Activate
Range("area2").Select
Selection.Copy
Windows(MyEntries).Activate
Cells(10, 1).Select
ActiveSheet.Paste
'Let PasteRange = ActiveSheet.Range
Let TopRow = ActiveCell.Row
Let TOpCol = ActiveCell.Column
Let rowcount = Selection.Rows.Count
Let ColCount = Selection.Columns.Count
ActiveWorkbook.Names.Add Name:="area2", RefersToR1C1:="=Sheet1!" & "R" &
TopRow & "C" & TOpCol & ":R" & rowcount + TopRow - 1 & "C" & ColCount +
TOpCol - 1


End Sub