VBA宏将数据从一个excel文件复制到另一个excel文件

Question

我有2本Excel工作簿.两者都在不同的文件夹中.我使用a将数据从一个复制到另一个macro.

我观察到一个超出范围错误的下标......

对此有何见解？

这是我的代码

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

好的,我想我明白了.而不是.Activate,如果它已经打开,我们将只设置它.我们还将通过其文件名引用该书,而不是路径(正如我在上面的评论中错误地建议的那样).

这对我有用:

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