VBA copy from an open workbook

Question

I have a small big problem with a very simple thing to do (apparently) in VBA. I have two workbooks. The first one is a tracker, saved on my computer. The second one is a file I receive daily, which I never save. This second excel file can have different names, therefore I cannot have a name in my code. I need to copy a range of cells from the second excel to my tracker. This is what I have and doesn't work (nothing happens when I action the command button):

  Sub OpenClose_Click()
    Dim i As Long
    Dim Filename As String
    Dim CellRange As String
    Dim wbkCur As Workbook
    Dim wbkNew As Workbook
    Set wbkCur = Workbooks("tracker")

        Filename = "C:\Users\tracker.xlsm"
        Set wbkNew = Workbooks.Open(Filename:=Filename)

        wbkNew.Worksheets("Info").Range("D8").Value=wbkCur.Worksheets("Data").Range("A2").Value 
        wbkNew.Close SaveChanges:=True

End Sub

Answer 1

The easiest thing is probably going to be using a file picker from FileDialog, especially if your second workbook is not consistent.

Sub OpenClose_Click()

'Create a variable to hold the path
Dim wbkNewPath As String

'Select the file
MsgBox ("Please choose location of file to be imported:")

With Application.FileDialog(msoFileDialogOpen)
    .Show
        If .SelectedItems.Count = 1 Then
        wbkNewPath = .SelectedItems(1)
    End If
End With

'Cancel will return vbNullString, so end the procedure
If wbkNewPath = vbNullString Then End

'New workbook variables
Dim wbkNew As Workbook
Set wbkNew = Workbooks.Open(wbkNewPath)
Dim wbkNewInfo As Worksheet
Set wbkNewInfo = wbkNew.Sheets("Info")

'Create variables for current workbook
Dim wbkCur As Workbook
Set wbkCur = ThisWorkbook
Dim wbkCurData as worksheet
Set wbkCurData = wbkCur.Sheets("Data")

'Copy Data
wbkNewInfo.Range("D8").Value = wbkCurData.Range("A2").Value 
wbkNew.Close SaveChanges:=True

End Sub

Answer 2

I copied this from one of my projects that does something close. I'm capturing orders from a CSV file daily and keeping a list of those orders in the master spreadsheet until the processing is completed for those orders. This might be a little overkill, but it should do everything you need and help you make the process more robust. You can add a line into your command button click event:

Global Const AppName = "DailyMacro.xlsm"

Sub Command1_Click()
    call ImportOrders
End Sub

Public Sub ImportOrders()

    Dim iFile As String, WorkbookName As String, ValidFile As Boolean, Path As String
    Application.ScreenUpdating = False
    '--dialog box to select today's file
    iFile = ImportFilename()
    ValidFile = True
    If iFile <> "" Then
        WorkbookName = StripPath(iFile)
        If ConfirmExcelFile(WorkbookName) Then 
            Workbooks(WorkbookName).Activate
            With Worksheets(1)
                .Activate
                '--verify correct file type (depends on your needs)
                If Not (.Range("A1").Text = "H" And .Range("B1").Text = "PO") Then
                    ValidFile = False  'not a valid file
                Else
                    '--last row in column 'c'
                    LR = LastRow(Worksheets(1).Name, "C")
                    If LR < 2 Then ValidFile = False
                End If
                '--copy over today's data
                If ValidFile = True Then .Range("A2:AE" & LR - 1).Copy
            End With
            If ValidFile = True Then
                Workbooks(AppName).Activate
                With Worksheets(oFile)
                    .Activate
                    '--last row of existing data
                    LR = LastRow(oFile, "C")
                    '--append new rows to end 
                    .Range("A" & LR + 1).Select
                    ActiveSheet.Paste
                    Application.CutCopyMode = False
                End With
            Else
                MsgBox "Import file wrong format or empty. Please check and try again.", vbCritical, "ERROR"
            End If
        End If
        Workbooks(WorkbookName).Close
    End If
    Application.ScreenUpdating = True

End Sub

Private Function ImportFilename() As String

    Dim fName As String, fTitle As String, fFilter As String, LR As Long
    fTitle = "Please choose a file to open"
    fFilter = "Comma Separated Value *.csv* (*.csv*),"
    fName = Application.GetOpenFilename(Title:=fTitle, fileFilter:=fFilter)
    If fName = "False" Then
        MsgBox "No file selected.", vbExclamation, "Sorry!"
        Exit Function
    Else
        Workbooks.Open Filename:=fName
        ImportFilename = fName
    End If

End Function

Function StripPath(Filename) As String
    Dim X As Integer, NewName As String, saveName As String
    X = InStrRev(Filename, "\")
    If X <> 0 Then
        saveName = Mid(Filename, X + 1, Len(FileName))
    End If
    StripPath = saveName
End Function

Function ConfirmExcelFile(Filename As String) As Boolean
    On Error GoTo BadFile
    'confirm that we have valid excel file
    If Workbooks(Filename).Worksheets.Count > 0 Then
        'now check to see if there is any data contained
        With Workbooks(Filename).Worksheets(1)
            If LastRow(.Name, "C") > 2 Then
                ConfirmExcelFile = True
                Exit Function
            Else
                MsgBox "Selected file does not contain data.", vbExclamation, "Error!"
                Exit Function
            End If
        End With
    End If
BadFile:
    MsgBox "Selected file is not compatible.", vbExclamation, "Error!"
End Function

Function LastRow(Tabname As String, Col As String) As Long
   With Worksheets(Tabname)
       LastRow = .Cells(Rows.Count, Col).End(xlUp).Row
   End With
End Function