Copy Named Ranges from One Workbook To Another

[Anne Troy]

I'm pretty sure it's completely wrong, but here's what I've got:

Sub CopyToOAApp()

End Sub
Dim wbk As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = "wcs3.xlsm"
strSecondFile = "oaapp.xlsm"

Set wbk = Workbooks(strFirstFile)
With wbk.Sheets("Dashboard")
.Range("merchfirstname").Copy
.Range("merchconame").Copy
.Range("merchemail").Copy
.Range("repemail").Copy
End With
Set wbk = Workbooks.Open(strSecondFile)
With wbk.Sheets("Dashboard")
.Range("a:d").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End With


End Sub

Those are the 4 named ranges I want to copy from wcs3.xlsm to oaapp.xlsm. The named ranges are the same in both workbooks. I copied someone's code, and began to alter it, but stalled on how to do the paste range. Theirs was, of course, a:d. I don't want the user to have to select any cells to get the data over.

Thanks tons for any help you can provide!

 

[Engineer Joe]

might try this. it takes it from your named ranges in the first book and puts them into A1,B1,C1,D1, respectively in the second book. I haven't tested it...so there may be slight syntax error.

Sub CopyToOAApp()

Dim wbk1 As Workbook
Dim wbk2 As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

strFirstFile = "wcs3.xlsm"
strSecondFile = "oaapp.xlsm"

Set wbk1 = Workbooks(strFirstFile)
Set wbk2 = Workbooks.Open(strSecondFile)

wbk2.sheets("Dashboard").range("A1").value = wbk1.Sheets("Dashboard").Range("merchfirstname")

wbk2.sheets("Dashboard").range("B1").value = wbk1.Sheets("Dashboard").Range("merchconame")

wbk2.sheets("Dashboard").range("C1").value = wbk1.Sheets("Dashboard").Range("merchemail")

wbk2.sheets("Dashboard").range("D1").value = wbk1.Sheets("Dashboard").Range("repemail")

End Sub

 

[Engineer Joe]

The code below probably more adequately reflects your request though. Again, untested.

Sub CopyToOAApp()

Dim copysheet As Worksheet
Dim pastesheet As Worksheet

Set copysheet = Workbooks("wcs3.xlsm").Sheets("Dashboard")
Set pastesheet = Workbooks("oaapp.xlsm").Sheets("Dashboard")

copysheet.Range("merchfirstname").Copy
Paste pastesheet.Range("merchfirstname")

copysheet.Range("merchconame").Copy
Paste pastesheet.Range("merchconame")

copysheet.Range("merchemail").Copy
Paste pastesheet.Range("merchemail")

copysheet.Range("repemail").Copy
Paste pastesheet.Range("repemail")

End Sub

 

[xenou]

^^ that was my take too ... have to copy each in turn...

Dim wbk(1) As Workbook
Dim strFirstFile As String
Dim strSecondFile As String

    strFirstFile = "wcs3.xlsm"
    strSecondFile = "oaapp.xlsm"
    
    Set wbk(0) = Workbooks(strFirstFile)
    Set wbk(1) = Workbooks.Open(strSecondFile)
    
    wbk(0).Sheets("Dashboard").Range("merchfirstname").Copy
    wbk(1).Sheets("Dashboard").Range("merchfirstname").PasteSpecial
    wbk(0).Sheets("Dashboard").Range("merchconame").Copy
    wbk(1).Sheets("Dashboard").Range("merchconame").PasteSpecial
    wbk(0).Sheets("Dashboard").Range("merchemail").Copy
    wbk(1).Sheets("Dashboard").Range("merchemail").PasteSpecial
    wbk(0).Sheets("Dashboard").Range("repemail").Copy
    wbk(1).Sheets("Dashboard").Range("repemail").PasteSpecial
    
    Application.CutCopyMode = False

The above assumes that the ranges are always the same size in both workbooks.

 

[Engineer Joe]

yeah, but the difference between an MVP and a lowly board regular is that xenou chose to use a 1 dimensional workbook array of 2 elements to declare workbooks. i wish i'd thought of that. i consider myself to be among the lazy, which has made me a decent programmer...but this sets a new precedent.

 

[xenou]

If I work at it I can be even lazier ...

Dim wbk(1) As Workbook
Dim a
Dim i As Long
    
    Set wbk(0) = Workbooks("wcs3.xlsm")
    Set wbk(1) = Workbooks.Open("oaapp.xlsm")
    
    a = Array("merchfirstname", "merchconame", "merchemail", "repemail")
    For i = 0 To UBound(a)
        wbk(0).Sheets("Dashboard").Range(a(i)).Copy
        wbk(1).Sheets("Dashboard").Range(a(i)).PasteSpecial
    Next i
   
    Application.CutCopyMode = False

Note: but we really need the full path to open "oaapp.xlsm", I think ...

 

[Engineer Joe]

oh yeah, Anne Troy, he's got a point...if you've already got the 2nd workbook open, you should take "Open" out of that second little workbook definition...don't know if that's obvious.

xenou, that 2nd array actually did cross my mind, but at some point, you have to draw the line. I checked myself into vba rehab several months ago after realizing i had just written this function and was using it:

Function Teleport(startrange As Range, Endrange As Range)

    Endrange.Value = startrange.Value

End Function

 

[Anne Troy]

I did remove the Open. Figured that out. Got a subscript out of range error, though on this line:

wbk(0).Sheets("Dashboard").Range(a(i)).Copy

I'm using the following code to open the 2nd workbook first.

Sub OpenOAApp()
 Dim excelFile As String

 excelFile = "oaapp.xlsm"
 
  'open excel file "myfile.xls" in drive D:\
  Workbooks.Open "C:\Users\" & Environ("UserName") & "\Desktop\" & excelFile

End Sub

So, I'm not sure what's got focus (or if it matters) at that point.

Still digging. Thanks so much for your help, guys! And as you can see, I might be a MrExcel MVP, but that don't make me no Excel programmer.

 

[Engineer Joe]

Anne Troy,

I'm guessing it happened b/c the cell you are trying to copy isn't the active sheet. That's why i use Blah.value = blah.value. I've run into the same issue.

Using a bastardization of Xenou's code and your own, maybe try making it the activeworkbook...

Dim wbk(1) As Workbook
Dim a
Dim i As Long
Dim excelFile As String

    excelFile = "oaapp.xlsm"    
    Set wbk(0) = Workbooks("wcs3.xlsm")
    Set wbk(1) = Workbooks.Open("C:\Users\" & Environ("UserName") & "\Desktop\" & excelFile)
    
    a = Array("merchfirstname", "merchconame", "merchemail", "repemail")
    For i = 0 To UBound(a)
        wbk(0).Sheets("Dashboard").activate
        wbk(0).Sheets("Dashboard").Range(a(i)).Copy
        wbk(1).Sheets("Dashboard").activate
        wbk(1).Sheets("Dashboard").Range(a(i)).PasteSpecial
    Next i
   
    Application.CutCopyMode = False

 

[Anne Troy]

I'm going to use a different bastard.

Sub CopyToOAApp()
    
    Application.ScreenUpdating = False
    
    Windows("wcs.xlsm").Activate
    Range("merchfirstname").Copy
    Windows("OAApp.xlsm").Activate
    Range("merchfirstname").PasteSpecial Paste:=xlPasteValues
    
    Windows("wcs.xlsm").Activate
    Range("merchconame").Copy
    Windows("OAApp.xlsm").Activate
    Range("merchconame").PasteSpecial Paste:=xlPasteValues
    
    Windows("wcs.xlsm").Activate
    Range("merchemail").Copy
    Windows("OAApp.xlsm").Activate
    Range("merchemail").PasteSpecial Paste:=xlPasteValues
    
    Windows("wcs.xlsm").Activate
    Range("repemail").Copy
    Windows("OAApp.xlsm").Activate
    Range("repemail").PasteSpecial Paste:=xlPasteValues
    
    Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

I am certain it's not as clean and I'll probably revisit this post. However, rumor has it a real DB is being built to handle all this stuff. I'm not holding my breath.

Thanks you guys. You been GREAT.