Copy worksheet with named ranges to new workbook and keep names in

[Sandy]

Hello -

I have a worksheet in one work book with a large number of named ranges. I
want to use these named ranges in another workbook.

How do I copy a group of named ranges and paste them into the new worksheet
and still preserve the name definitions in the new worksheet?

Many thanks
sandra

 

[Mike H.]

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