且构网

分享程序员开发的那些事...
且构网 - 分享程序员编程开发的那些事

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

更新时间:2023-11-27 21:30:58

好的,我想我得到了而不是 .Activate ,我们只要设置这本书,如果它已经打开了。我们还将以其文件名NOT路径引用该书(正如我在上面的评论中错误地提出的)。

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).

这对我有用:

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