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

Question

我有 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设置书而不是.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

Answer 2

Sub CopyData()
Dim Book As Workbook ' probably not needed
Set destinationFile = ThisWorkbook ' probably not needed

sourceFile = ("Add your source file name")
sourceFileLocation = ("add your source file location")

Workbooks.Open (sourceFileLocation + "\" + sourceFile)
    Windows(sourceFile).Activate
    Range("A1:X7215").Select                 'Range Values can be changed depending upon the size of the data (total number of records and columns)
    Selection.Copy
    destinationFile.Activate
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    Windows(sourceFile).Activate
    ActiveWindow.Close
End Sub