VBA to Copy/Paste a Named Range from one Workbook to another

[khairalm]

Hello all,

I am trying to write a VBA macro to assist me in copying few Named cells from one workbook to another.

Source workbook: "WBSource"
Destination workbook: "WBDest" --- Destination workbook to hold the Macro

I want to be able to go to:
1. I manually open "WBDest"
2. Run a macro "Macro"
3. Macro asks me for the path of "WBSource", and open it
4. Macro copy the values of two named ranges "NamedRange1" and "NamedRange2" from WBSource
5. Macro go back to WBDest, open a specific sheet "TargetSheet" and paste (values only) NamedRange1 to Cell D9 and NamedRange2 to D10 of the "TargetSheet" in "WBDest"

Looking around in the internet, I was able to put together the below code that copies 1 cell from WBSource to WBDest. I am looking for assistance to modify the below code to do what's described above.


Thank you in advance

Sub Macro()



Dim WBSourcePath As String: WBSourcePath = Application.GetOpenFilename(, , "Locate the WBSource") 'Step [A]: Grabs the WBsource file path


Set WBSource = Workbooks.Open(Filename:=WBSourcePath) 'Define WBSource as path from Step [A]
Set WBDest = ThisWorkbook


WBSource.Worksheets("Input").Select
Range("A20").Copy 'Copy the A20 from Sheet "Input" WBSource info

WBDest.Worksheets("TargetSheet").Activate
Range("D9").PasteSpecial Paste:=xlPasteValues 'Paste values into WBDest Sheet TargetSheet Cell D9


Application.CutCopyMode = False 'Forbids Macro from cutting information from Active workbook, the active selection tool

MsgBox ("Done")


End Sub

 

[DanteAmor]

Hi and welcome to MrExcel

Try this

Sub Macro()
  Dim WBSourcePath As Variant, WBSource As Workbook, shDest As Worksheet
  
  Set shDest = ThisWorkbook.Sheets("TargetSheet")
  WBSourcePath = Application.GetOpenFilename(, , "Locate the WBSource") 'Step [A]: Grabs the WBsource file path
  If WBSourcePath = False Then Exit Sub
  Set WBSource = Workbooks.Open(Filename:=WBSourcePath) 'Define WBSource as path from Step [A]
  shDest.Range("D9").Value = Range("NamedRange1")
  shDest.Range("D10").Value = Range("NamedRange2")
  WBSource.Close False
  MsgBox ("Done")
End Sub

 

[khairalm]

Hi and welcome to MrExcel

Try this

Sub Macro()
  Dim WBSourcePath As Variant, WBSource As Workbook, shDest As Worksheet
 
  Set shDest = ThisWorkbook.Sheets("TargetSheet")
  WBSourcePath = Application.GetOpenFilename(, , "Locate the WBSource") 'Step [A]: Grabs the WBsource file path
  If WBSourcePath = False Then Exit Sub
  Set WBSource = Workbooks.Open(Filename:=WBSourcePath) 'Define WBSource as path from Step [A]
  shDest.Range("D9").Value = Range("NamedRange1")
  shDest.Range("D10").Value = Range("NamedRange2")
  WBSource.Close False
  MsgBox ("Done")
End Sub

Dante,

Thank you very much. This code did exactly what I wanted it to do.
Now that I am trying to do the samething but with a named table "Data_Table", changing

shDest.Range("D9").Value = Range("NamedRange1")

to

shDest.Range("D9").Value = Range("Data_Table")

doesn't work. I assume "Range" is not the correct object for a table.


Thank you,

 

[DanteAmor]

But this is only for one cell.

shDest.Range("D9").Value

Do you want to copy the entire table?

 

[khairalm]

But this is only for one cell.

shDest.Range("D9").Value

Do you want to copy the entire table?

Correct, I would like to be able to copy a whole table from WBSource to shDest

At first I thought I can get by copy/pasting individual cells, but If you can assist me copy/past whole table, that would drastically reduce the code/maintenance of the code

Really appreciate your help this far

 

[DanteAmor]

Try this

Sub Macro()
  Dim WBSourcePath As Variant, WBSource As Workbook, shDest As Worksheet
  
  Set shDest = ThisWorkbook.Sheets("TargetSheet")
  WBSourcePath = Application.GetOpenFilename(, , "Locate the WBSource") 'Step [A]: Grabs the WBsource file path
  If WBSourcePath = False Then Exit Sub
  Set WBSource = Workbooks.Open(Filename:=WBSourcePath) 'Define WBSource as path from Step [A]
  Range("NamedRange1").Copy shDest.Range("D9")
  Range("NamedRange2").Copy shDest.Range("D10")
  WBSource.Close False
  MsgBox ("Done")
End Sub

 

[khairalm]

The worked great!
All I had to doe is switch


Range("NamedRange1").Copy shDest.Range("D9")
to
Range("NamedRange1").Copy shDest.Range("D9").PasteSpecial Paste:=xlPasteValues
So that i don't mess up the names (Both workbooks share some names).


Again, thank you very much!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[khairalm]

Hello Dante,

I have been trying to repurpose the macro you helped me with previously. Here's what I invasion it doing:
Source workbook: "WBSource" (where the NamedRanges will be copied FROM)
Destination workbook: "WBDest" (where the NamedRanges will be copied TO)
1. I manually open "WBDest"
2. Run a macro "Macro"
3. Macro asks me for the path of "WBSource", and open it
4. [Begining of LOOP] Macro Loop through "Table2", Each cell "X" contains the name of a named range that needs to be transferred from WBSource.
5. [LOOP] Macro Copy the named range "X", and paste it to "TargetSheet" Column F Below the last used Row
6. [LOOP END] For Next X, until we looped through all cells of "Table2" <-- Table2 is a one-column table
7. [[OPTIONAL Step] Turn the copied cell into a named range and name it X.value & Cell F9 value. so if X is holding "FFCost" and Cell F9 value is "_3", I want the copied item to be called "FFCost_3"

Below is what I have been trying to make work. However, I keep getting an error "Method 'Range' of object '_Global' failed"

Sub Import_Test2()
    On Error GoTo HandleError
    Application.ScreenUpdating = False
    
    Dim WBSourcePath As Variant
    Dim WBSource As Workbook
    Dim shDest As Worksheet
    Dim X As Range

    
    Set shDest = ThisWorkbook.Sheets("TargetSheet")
    
    WBSourcePath = Application.GetOpenFilename(, , "Locate the WBSource")
    If WBSourcePath = False Then Exit Sub
    
    Set WBSource = Workbooks.Open(Filename:=WBSourcePath)
    
    
    
    For Each X In Range("Table2")
        shDest.Range("f9").Value = Range(Xname)
        'MISSING ALOT HERE'
        
    Next X
    
    WBSource.Close False
    MsgBox ("Data has been imported")
    
HandleExit:
    Application.ScreenUpdating = True
    Exit Sub
HandleError:
    MsgBox Err.Description
    Resume HandleExit
End Sub

As you can see, my main issue is the Loop. I tried to come up with the answer looking at other posts, but I don't think I have the code aptitude to fully work it out.

Your help is very much appreciated.