VBAmacros将数据从一个Excel文件复制到另一个

我有2个Excel工作簿。 两者都在不同的文件夹中。 我使用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 ，我们只要设置该书，如果它已经打开。 我们还将通过其文件名称NOT NOT引用本书（正如我在上面的注释中错误地提出的那样）。

这对我工作：

 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