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

本文介绍了VBA宏将数据从一个excel文件复制到另一个的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！ 问题描述

我有2个 Excel 工作簿。两者都在不同的文件夹。 我使用宏将数据复制到另一个宏。

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

对此有任何见解？

这是我的代码

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

推荐答案

好的，我想我得到了而不是 .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