Transfer data from one workbook to another

Hi there,

This can indeed be tricky. There are several ways to do it. The first question I would ask is where you're doing this from. Since it's a set of floating files, where is your code stored? Do you have a control workbook you're using to house the code? Since the [source] file may not house the code, I'd suggest an add-in. That way you'd always have the button on your ribbon (or whatever UI you wanted to give it). But if you haven't created one, probably better to use a control workbook to at least get you up and running. From there, if you wanted, you could change that file into an add-in if desired.

So, assuming we're going to be working with a [standalone] control workbook, I'd place three buttons on a worksheet. One to browse for the source file, another to browse for the target file, and another to fire/trigger the data transfer. For both source and target file buttons I'd make sure and have a cell to place the file path/name into. I would use named ranges/accessors, but that's something altogether different, but helps coding a bit faster IMO. For now I'll assume you're not using those and the workbook is setup as I described, with the source file cell being in A3 of 'Sheet1', and the target file cell being in A6 of 'Sheet1'. This gives you room for a title above each cell and a little white space.

Here is the code I would use:

Option Explicit


Public Sub GetSourceFile()

    Dim SourceFilePath As Variant

    SourceFilePath = Application.GetOpenFilename("Excel files (*.xls, *.xlsx, *.xlsm, *.xlsb), *.xls, *.xlsx, *.xlsm, *.xlsb", , "Source File")
    If SourceFilePath = False Then Exit Sub
    ThisWorkbook.Worksheets("Sheet1").Range("A3").Value = SourceFilePath

End Sub


Public Sub GetTargetFile()

    Dim TargetFilePath As Variant

    TargetFilePath = Application.GetOpenFilename("Excel files (*.xls, *.xlsx, *.xlsm, *.xlsb), *.xls, *.xlsx, *.xlsm, *.xlsb", , "Target File")
    If TargetFilePath = False Then Exit Sub
    ThisWorkbook.Worksheets("Sheet1").Range("A6").Value = TargetFilePath

End Sub


Public Sub TransferSourceToTarget()

    Dim SourceBook As Workbook
    Dim TargetBook As Workbook
    Dim SourceOpen As Boolean
    Dim TargetOpen As Boolean
    Dim SourceName As String
    Dim SourcePath As String
    Dim TargetName As String
    Dim TargetPath As String

    SourcePath = ThisWorkbook.Worksheets("Sheet1").Range("A3").Value
    TargetPath = ThisWorkbook.Worksheets("Sheet1").Range("A6").Value

    If SourcePath = vbNullString Or TargetPath = vbNullString Then
        MsgBox "Please choose a source and target file", vbExclamation, "Error"
        Exit Sub
    End If

    If Not ExistingFile(SourcePath) Or Not ExistingFile(TargetPath) Then
        MsgBox "Please make sure the source and target files exist", vbExclamation, "Error"
        Exit Sub
    End If
    
    SourceName = Right(SourcePath, Len(SourcePath) - InStrRev(SourcePath, Application.PathSeparator))
    TargetName = Right(TargetPath, Len(TargetPath) - InStrRev(TargetPath, Application.PathSeparator))

    SourceOpen = IsWorkbookOpen(SourceName)
    If Not SourceOpen Then
        Set SourceBook = Workbooks(SourceName)
    Else
        Set SourceBook = Workbooks.Open(SourcePath)
    End If
    
    TargetOpen = IsWorkbookOpen(TargetName)
    If Not TargetOpen Then
        Set TargetBook = Workbooks(TargetName)
    Else
        Set TargetBook = Workbooks.Open(TargetPath)
    End If
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Run your code here using 'SourceBook' and 'TargetBook' as the Workbook objects
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

   If Not SourceOpen Then SourceBook.Close SaveChanges:=False
   If Not TargetOpen Then TargetBook.Close SaveChanges:=True

End Sub


Public Function ExistingFile( _
       ByVal FilePath As String _
       ) As Boolean

' Return True if the file or folder exists, False otherwise. This routine does not use the Dir
' technique as the Dir function resets any current Dir process, and does not handle long file paths.

    Dim Attributes As Integer

    On Error Resume Next
    ' For long file paths, uncomment this next line...
'    If Len(FilePath) >= MAX_PATH Then FilePath = GetShortFolderName(FilePath)
    Attributes = GetAttr(FilePath)
    ExistingFile = (Err.Number = 0) And (Attributes And vbDirectory) = 0
    Err.Clear

End Function


Function IsWorkbookOpen( _
         ByVal WorkbookName As String _
         ) As Boolean

' Returns True if the specified workbook is found open in the current instance of Excel.

    On Error Resume Next
    IsWorkbookOpen = CBool(Len(Workbooks(WorkbookName).Name) <> 0)
    On Error GoTo 0

End Function



'' For long file paths, add these to the top of the module...
'Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameW" ( _
 '                                          ByVal lpszLongPath As Long, _
 '                                          ByVal lpszShortPath As Long, _
 '                                          ByVal cchBuffer As Long _
 '                                          ) As Long
'Public Const MAX_PATH = 255
'' and add this somewhere in your module...
'Public Function GetShortFolderName( _
 '    ByVal FullPath As String _
 '    ) As String
'
'    Dim Result As Long
'    Dim FilePath As String
'    Dim PathBuffer As String
'
'    On Error Resume Next
'    FullPath = "\\?\" & FullPath
'
'    PathBuffer = String$(MAX_PATH + 1, vbNull)
'    Result = GetShortPathName(StrPtr(FullPath), StrPtr(PathBuffer), Len(PathBuffer))
'
'    GetShortFolderName = Right(Left(PathBuffer, CLng(Result)), CLng(Result) - 4)
'
'End Function

Assign these two routines to your buttons for getting source and target files respectively:

GetSourceFile()

GetTargetFile()

Your third button should be assigned this routine:

TransferSourceToTarget()

These are supporting functions:

ExistingFile()

IsWorkbookOpen()

There is a few additional lines of code at the bottom. I added this in the off-chance you have long file paths, in which case 'ExistingFile' will bomb because it can't handle longer than 260 characters (specifically the GetAttr() function can't handle it). If you do need to use it, there is an API and a constant which would need to go at the top of your module above all other code, and below the 'Option Explicit'. The other routine (GetShortFolderName) can go anywhere below in the module. Typically this isn't needed, but as it bit me in the behind once, figured I'd add it here just in case. 

As a side note, in the routine 'TransferSourceToTarget' I show where to place your code. You could, if you wanted, just pass the two workbook objects as variables into another routine. Sometimes it makes things cleaner. You would then just use something this line:

    Call YourCurrentRoutineName(SourceBook, TargetBook)

And you would need to adjust your routine to add the parameters, like this...

Sub YourCurrentRoutineName(ByVal Source As Workbook, ByVal Target As Workbook)

' Your code here
' Use the workbooks Source and Target as you want.
' For example...
Debug.Print Source.Name, Target.Name
End Sub

It's really up to you and how you want to keep your module organized. Personal preference all the way. I mention it because typically I will break things up into functional chunks. While I like it better, you might not. Totally preference.

Hope this helps!