VBA macro to copy data from one excel file to another

Question

I have 2 Excel workbooks. Both are in different folders. I am copying data from one to another using a macro .

I observe a subscript out of range error...

Any insights in to this?

Here is my code

Sub copydata()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String

' check if the file is open 
ret = Isworkbookopen("C:\file1.xlsx") 
If ret = False Then
' open file
Set wkbSource = Workbooks.Open("C:\file1.xlsx")
Else
'Just make it active
 Workbooks("C:\file1.xlsx").Activate
 End If

' check if the file is open 

ret = Isworkbookopen("C:\File2.xlsx")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open("C:\file2.xlsx")
Else
'Just make it active
 Workbooks("file2.xlsx").Activate

End If

'perform copy
Set shttocopy = wkbSource.Sheets("filedata")
shttocopy.Copy wkbDest.Sheets(3)

End Sub

Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String

wbname = filename
On Error Resume Next

ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select

End Function

Answer 1

OK, I think I got it. Instead of .Activate , we'll just set the book if it's already open. We'll also reference the book by its file name, NOT path (as I had erroneously suggested in a comment above).

This worked for me:

Sub copydata()
Dim wkbSource As Workbook
Dim wkbDest As Workbook
Dim shttocopy As Worksheet
Dim wbname As String

' check if the file is open
ret = Isworkbookopen("C:\stack\file1.xlsx")
If ret = False Then
' open file
Set wkbSource = Workbooks.Open("C:\stack\file1.xlsx")
Else
'Just make it active
 'Workbooks("C:\stack\file1.xlsx").Activate
 Set wkbSource = Workbooks("file1.xlsx")
 End If

' check if the file is open

ret = Isworkbookopen("C:\stack\File2.xlsx")
If ret = False Then
' open file
Set wkbDest = Workbooks.Open("C:\stack\file2.xlsx")
Else
'Just make it active
 'Workbooks("C:\stack\file2.xlsx").Activate
 Set wkbDest = Workbooks("file2.xlsx")

End If

'perform copy
Set shttocopy = wkbSource.Sheets("filedata")
shttocopy.Copy wkbDest.Sheets(3)

End Sub

Function Isworkbookopen(filename As String)
Dim ff As Long, ErrNo As Long
Dim wkb As Workbook
Dim nam As String

wbname = filename
On Error Resume Next

ff = FreeFile()
Open filename For Input Lock Read As #ff
Close ff
ErrNo = Err
On Error GoTo 0
Select Case ErrNo
Case 0: Isworkbookopen = False
Case 70: Isworkbookopen = True
Case Else: Error ErrNo
End Select

End Function

Answer 2

Sub CopyData()
Dim Book As Workbook ' probably not needed
Set destinationFile = ThisWorkbook ' probably not needed

sourceFile = ("Add your source file name")
sourceFileLocation = ("add your source file location")

Workbooks.Open (sourceFileLocation + "\" + sourceFile)
    Windows(sourceFile).Activate
    Range("A1:X7215").Select                 'Range Values can be changed depending upon the size of the data (total number of records and columns)
    Selection.Copy
    destinationFile.Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Windows(sourceFile).Activate
    ActiveWindow.Close
End Sub