transferring Named Ranges to a new workbook

[Youngdand]

Hi,

I have a Work book in excel which uses macros to filter a master set of invoice data and draw 4 separate documents based on the client chosen. I then have a macro to create PDF copies of 3 of the sheets, and an excel workbook containing the invoice line details.

The Source sheet used contains around 30 named ranges, which i need to transfer to the newly created document.
Below is the code i am using:

Sub ExportPDF()
Dim Data As Worksheet
Set Data = Sheets("data")

Application.ScreenUpdating = False

Dim newWB As Workbook, currentWB As Workbook
Dim newS As Worksheet, currentS As Worksheet
Dim ws1 As Worksheet, ws2 As Worksheet
Dim APheader As Long, APtotal As Long, kount As Long
Dim Formula As Worksheet
Dim Frange As Range
Dim Statement As Worksheet
Dim Remittance As Worksheet
Dim Invoice As Worksheet
Dim filen As String
Dim Fpath As String
Dim Client As Range
Dim Info As Range
Dim DPath As String
Dim salesman As Range
Set salesman = Range("salesman")
Set Client = Range("Client")
Set Formula = Sheets("formula")
Set Info = Range("info")

DPath = "\\xxx.xxx.x.xx\Accounts\Remittances\Working Folder\"
'create Directories
If Len(Dir(DPath & salesman, vbDirectory)) = 0 Then
MkDir DPath & salesman
End If

If Len(Dir(DPath & salesman & "\" & Client.Value, vbDirectory)) = 0 Then
MkDir DPath & salesman & "\" & Client.Value
End If

'Set file save path and range for file name
Fpath = DPath & salesman & "\" & Client.Value & "\"
filen = Range("invoicenumber")

Set Statement = Sheets("Statement")
Set Remittance = Sheets("Remittance Advice")
Set Invoice = Sheets("Invoice")


'Export PDF files

Statement.Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fpath & filen & "_Statement" & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Remittance.Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fpath & filen & "_Remittance" & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Invoice.Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Fpath & filen & "_Invoice" & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Data.Activate
'Copy the data sheet
Set currentWB = ThisWorkbook
Set currentS = currentWB.Sheets("Data")
currentS.UsedRange.Select
Selection.Copy

Set newWB = Workbooks.Add
    With newWB
        Set newS = newWB.Sheets("Sheet1")
        newS.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        newS.Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        Rows("1:6").Select
        Selection.EntireRow.Delete
        Columns("A:H").Select
        Selection.EntireColumn.AutoFit
        .SaveAs Filename:=Fpath & filen & ".xlsx"
        Application.PrintCommunication = False
        With newWB.ActiveSheet.PageSetup
        .Zoom = 100
        .FitToPagesWide = 1
        .FitToPagesTall = False
        End With
        .Save
        Application.PrintCommunication = True
        ActiveWorkbook.Close
        Application.DisplayAlerts = True
    End With
    
Formula.Activate
    With Sheets("formula")
        If .AutoFilterMode Then .AutoFilterMode = False
            With .Range("info")
                .AutoFilter
                .AutoFilter Field:=1, Criteria1:=Range("Client").Value
                Set Frange = Range("a2", Range("a" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
                Frange.EntireRow.Interior.ColorIndex = 6
            End With
    End With
Data.Activate
Range("A1").Select
Application.CutCopyMode = False
Formula.AutoFilterMode = False
Application.ScreenUpdating = True
End Sub

When the new sheet is created, only 4 of the named ranges are transferred, and they all appear to refer back to the source document.
Firstly, is it due to using used range for the copy that is causing not all ranges to be transferred? although all the named ranges are in this range.

Secondly, is there a way to ensure that the named ranges in the new document refer to the relative range in the the new document, and not relate back to the source? as the source document will change everytime a new client is processed.

Any Advice you can give would be great.

Thanks,

Dan.

 

[JLGWhiz]

I think you would need to copy the named ranges per this link:
https://excelribbon.tips.net/T008811_Copying_Named_Ranges.html

Then copy the rest of your workbook as values.

 

[pbornemeier]

This code makes irrevocable changes. TEST ON A COPY OF YOUR DATA

Use this code to document the named ranges in your source document:

Sub Document_Names()

    Dim sht As Sheets
    Dim nm As Name
    Dim intX As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    'Delete old report worksheet
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("List.Names").Delete
    Application.DisplayAlerts = True
    
    'Add a new sheet to list all external links.
    Sheets.Add().Name = "List.Names"
    
    Sheets("List.Names").Cells(1, 1) = "Name"
    Sheets("List.Names").Cells(1, 2) = "Type"
    Sheets("List.Names").Cells(1, 3) = "Formula"
    
    'Format column A:D as text.
    Sheets("List.Names").Range("1:3").NumberFormat = "@"
    
    For intX = 1 To ActiveWorkbook.Names.Count
        With ActiveWorkbook.Names(intX)
            Application.StatusBar = intX & "/" & ActiveWorkbook.Names.Count
            Sheets("List.Names").Cells _
                (Rows.Count, 1).End(xlUp).Offset(1, 0) = .Name
            If .MacroType <> xlNone Then
                Sheets("List.Names").Cells _
                    (Rows.Count, 2).End(xlUp).Offset(1, 0) = _
                    Switch(.MacroType = _
                    xlCommand, "Macro", .MacroType = xlFunction, "Function", .MacroType = xlNotXLM, "Not Fn or Macro")
            Else
                Sheets("List.Names").Cells _
                    (Rows.Count, 2).End(xlUp).Offset(1, 0) = "None"
            End If
        
            Sheets("List.Names").Cells _
                (Rows.Count, 3).End(xlUp).Offset(1, 0) = "'" & .RefersTo
        End With
    Next
    
    Columns("A:C").ColumnWidth = 100
    Columns("A:C").EntireColumn.AutoFit
    With Columns("C:C")
        .ColumnWidth = 50
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    Columns("A:C").EntireRow.AutoFit
    
    Rows("2:2").Select
    'ActiveWindow.FreezePanes = True
    Range("A2").Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = False

End Sub

Copy that worksheet to the new workbook then use this to delete any copied names and recreate names from that worksheet:

Sub RestoreNamedRanges()
    'from worksheet List.Names created by Document_Names
    Dim lLastRow As Long
    Dim lRowIndex As Long
    Dim arySplit As Variant
    Dim sRangeName As String
    Dim sWorksheetName As String
    Dim nameOld As Name
    Dim sRefersTo As String
    
    Select Case MsgBox("Do you want to delete the existing named ranges in " & ActiveWorkbook.Name & " before adding new ranged names?" & vbLf & vbLf & _
        "    Yes" & vbTab & "to delete existing and add new" & vbLf & _
        "    No" & vbTab & "to add names without deleting old names" & vbLf & _
        "    Cancel" & vbTab & "to stop without deleting old or adding new", vbYesNoCancel, "Delete Existing Named Ranges Before Adding New Ones?")
    Case vbYes
        'Delete names
        For Each nameOld In ThisWorkbook.Names
            nameOld.Delete
        Next
    Case vbNo
        'Continue
    Case Else
        'Cancle
        GoTo End_Sub
    End Select
    
    'Add Names
    With Worksheets("List.Names")
        lLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        For lRowIndex = 2 To lLastRow
            sRefersTo = .Cells(lRowIndex, 3).Value
            sRefersTo = Replace(sRefersTo, "=", "")
            sRefersTo = Replace(sRefersTo, """", "")
            
            If InStr(.Cells(lRowIndex, 1).Value, "!") > 0 Then
                'Worksheet Name
                arySplit = Split(.Cells(lRowIndex, 1).Value, "!")
                sRangeName = arySplit(1)
                If Right(sRangeName, 1) = "'" Then sRangeName = "'" & sRangeName
                
                sWorksheetName = arySplit(0)
                sWorksheetName = Replace(sWorksheetName, "'", "")
                With ActiveWorkbook.Worksheets(sWorksheetName)
                    .Names.Add Name:=sRangeName, RefersToR1C1:= _
                         sRefersTo
                    .Names(sRangeName).Comment = .Cells(lRowIndex, 4).Value
                End With
            Else
                'Workbook Name
                sRangeName = .Cells(lRowIndex, 1).Value
                ActiveWorkbook.Names.Add Name:=sRangeName, RefersToR1C1:= _
                    sRefersTo
                ActiveWorkbook.Names(sRangeName).Comment = .Cells(lRowIndex, 4).Value
            End If
        Next
    End With
    
End_Sub:
    
End Sub

 

[Youngdand]

HI,

Thanks a million for this, i will have to take the weekend to digest it!
its a little more complex than i was expecting.

Have a great weekend.

Cheers,

Dan.

 

[Youngdand]

Hi All,

Thanks for all the suggestions on this. However eventually, went in a slightly different direction, as i needed to keep all the code within the main document being used, and not have multiple stages as my aim in this was to make the process more simple.

The way i have overcome this is instead of just copying the usedrange, to create a copy of the entire sheet to a new workbook and name the sheet the same as the source. This seems to bring all names across ok and they appear to be relative to the new sheet.

I have then written more simplistic code, which the end users are more likely to understand (or at least can follow from the comments) should they need to, which removes the buttons copied from the source, replaces formulas with values, deletes unwanted data, and performs the formatting requirements ready for print.


Again thanks very much for the help, and things you have posted have helped greatly in tryin gto nail down a suitable way of performing this.

Regards,

Dan.