vba VBA宏将数据从一个excel文件复制到另一个
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23118844/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA macro to copy data from one excel file to another
提问by Free your mind
I have 2 Excelworkbooks. Both are in different folders.
I am copying data from one to another using a macro.
我有2本Excel工作簿。两者都在不同的文件夹中。我正在使用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
回答by Dan Wagner
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).
好的，我想我明白了。取而代之的是.Activate，如果书已经打开，我们将只设置它。我们还将通过文件名而不是路径来引用这本书（正如我在上面的评论中错误地建议的那样）。
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
