运行 时间错误“424”：Object 将数据从一个工作簿复制到活动工作簿时需要
Run Time Error "424": Object Required when copying data from one workbook to an active one
晚上好。
我一直在从事以下项目，它产生了几个 424 运行 时间错误。
ThisWorkbook 中声明了以下 public 子项：
Public Sub Workbook_Open()
Dim rolandPath As String 'Declares global string variable rolandFile for RoLanD's filepath
Dim rolandSource As Workbook ' declares global workbook variable rolandSource for RoLanD listed in rolandPath
Dim destinationWorkbook As Workbook 'declares global workbook variable destinationWorkbook for Extract Tool
Dim storeID As Integer ' Declares global integer variable storeID for Store's 4 digit ID
Dim tFocus As Long 'Declares global long variable tFocus for current Tab in focus
Dim cFocus As Long 'Declares global long variable cFocus for current Column in focus
Dim rFocus As Long 'Declares global long variable rFocus for current Row in focus
Dim rRecord As Long 'Declares global long variable rRecord for current Row being recorded to
Call DataConnect
End Sub
此代码的其余部分在模块 1 中：
Sub DataConnect()
MsgBox ("Please select your RoLanD file. If you are asked to enter your password, please do this. If you select Cancel, you may need to exit and restart this application.") 'Explains to the user what to do next.
FilePath = Application.GetOpenFilename 'Opens dialogue for user to select RoLanD file
If FilePath <> "" Then 'Checks that the filepath is completed
rolandPath = FilePath 'Stores the filepath for RoLanD into the variable rolandFile
End If
storeID = InputBox("Please enter your Store's four digit ID (EG: 0123). If you enter this incorrectly, this may result in your colleagues records being incorrectly applied", "Enter Store ID") ' Prompts user to enter store ID, then stores it as integer storeID
MsgBox ("Thank you. Your current RoLanD data will now be copied. This will leave your data intact in RoLanD, so please do not be concerned. Please select OK to continue.") 'Gives a message to reassure user.
cFocus = "Q" 'Sets the Column in focus to Column Q
rFocus = 5 'Sets the Row in focus to the fifth one
rRecord = 1 'Sets the row the record is being recorded to as the first one
tFocus = 1 'Sets the Tab in focus to the first one
Set rolandSource = Workbooks.Open(rolandPath)
On Error Resume Next ' tells DB to move on when error is reached
Do
Call tInFocus
tFocus = tFocus + 1 'Adds tab (worksheet) in focus up one
Loop Until Err.Number <> 0 'breaks when no more worksheets available
MsgBox ("Data is fully copied.")
End Sub
Sub tInFocus()
cFocus = "Q" 'Sets the Column in focus to Column Q
rFocus = 5 'Sets the Row in focus to the fifth one
If rolandSource.Worksheets(tFocus).Range("Q4").Value = "" Then Exit Sub 'Ends subroutine if Q4 is empty, which means no data on this RoLanD tab
Do
Do
ThisWorkbook.Worksheets("1").Range("A" & rRecord).Value = rolandSource.Sheets(tFocus).Range("B" & rFocus) 'Copies employee number in focus to destination
ThisWorkbook.Worksheets("1").Range("B" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & "4") ' Copies learning title in focus to destination
ThisWorkbook.Wksheets("1").Range("C" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & rFocus) 'Copies learning completion date in focus to destination
ThisWorkbook.Worksheets("1").Range("D" & rRecord).Value = storeID 'Copies store ID to row in focus
rRecord = rRecord + 1 'Moves line being recorded to on one
cFocus = Chr(Asc(cFocus) + 1) 'Moves column in focus up one
Loop Until rolandSource.Worksheets(tFocus).Range(cFocus & 4) = "" 'Breaks loop when end column reached
rFocus = rFocus + 1 'Moves row in focus up one
cFocus = "Q" 'Resets cFocus to Column Q
Loop Until rolandSource.Worksheets(tFocus).Range(B & rFocus) = "" 'Breaks loop when end row reached
End Sub
我有两个问题；第一个是 Loop Until Err.Number <> 0 在第一个实例之后结束。当 tFocus 处于不存在工作表的值时，这应该结束循环。
第二个也是更大的问题是以下几行在调试 window:
If rolandSource.Worksheets(tFocus).Range("Q4").Value = "" Then Exit Sub
ThisWorkbook.Worksheets("1").Range("A" & rRecord).Value = rolandSource.Sheets(tFocus).Range("B" & rFocus) '将焦点中的员工编号复制到目的地
ThisWorkbook.Worksheets("1").Range("B" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & "4" ) ' 将焦点中的学习标题复制到目的地
ThisWorkbook.Wksheets("1").Range("C" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & rFocus) '将焦点中的学习完成日期复制到目的地
ThisWorkbook.Worksheets("1").Range("D" & rRecord).Value = storeID '将商店 ID 复制到焦点行
Loop Until rolandSource.Worksheets(tFocus).Range(cFocus & 4) = "" '到达结束列时中断循环
Loop Until rolandSource.Worksheets(tFocus).Range(B & rFocus) = "" '到达结束行时中断循环
我阅读了几篇文章并尝试了不同的方法，包括将复制数据的行更改为以下内容：
rolandSource.Activate
rolandSource.Worksheet(tFocus).Cell("B" & rFocus).Copy
ThisWorkbook.Activate
ThisWorkbook.Worksheet(1).Call("A" & rRecord).Paste
这产生了相同的结果。
如有任何想法或支持，我们将不胜感激。休息了很长时间后，我又开始写代码了，我知道我可能在做一些非常愚蠢的事情，但我想不通是什么！
感谢期待，丹
感谢@TimWilliams，他指出我没有正确声明我的变量。此外，使用 chr(asc 更改列的错误在 "z" 之后不起作用（显然当你考虑它时），所以我改为使用 cell().
进行引用
晚上好。
我一直在从事以下项目，它产生了几个 424 运行 时间错误。
ThisWorkbook 中声明了以下 public 子项：
Public Sub Workbook_Open()
Dim rolandPath As String 'Declares global string variable rolandFile for RoLanD's filepath
Dim rolandSource As Workbook ' declares global workbook variable rolandSource for RoLanD listed in rolandPath
Dim destinationWorkbook As Workbook 'declares global workbook variable destinationWorkbook for Extract Tool
Dim storeID As Integer ' Declares global integer variable storeID for Store's 4 digit ID
Dim tFocus As Long 'Declares global long variable tFocus for current Tab in focus
Dim cFocus As Long 'Declares global long variable cFocus for current Column in focus
Dim rFocus As Long 'Declares global long variable rFocus for current Row in focus
Dim rRecord As Long 'Declares global long variable rRecord for current Row being recorded to
Call DataConnect
End Sub
此代码的其余部分在模块 1 中：
Sub DataConnect()
MsgBox ("Please select your RoLanD file. If you are asked to enter your password, please do this. If you select Cancel, you may need to exit and restart this application.") 'Explains to the user what to do next.
FilePath = Application.GetOpenFilename 'Opens dialogue for user to select RoLanD file
If FilePath <> "" Then 'Checks that the filepath is completed
rolandPath = FilePath 'Stores the filepath for RoLanD into the variable rolandFile
End If
storeID = InputBox("Please enter your Store's four digit ID (EG: 0123). If you enter this incorrectly, this may result in your colleagues records being incorrectly applied", "Enter Store ID") ' Prompts user to enter store ID, then stores it as integer storeID
MsgBox ("Thank you. Your current RoLanD data will now be copied. This will leave your data intact in RoLanD, so please do not be concerned. Please select OK to continue.") 'Gives a message to reassure user.
cFocus = "Q" 'Sets the Column in focus to Column Q
rFocus = 5 'Sets the Row in focus to the fifth one
rRecord = 1 'Sets the row the record is being recorded to as the first one
tFocus = 1 'Sets the Tab in focus to the first one
Set rolandSource = Workbooks.Open(rolandPath)
On Error Resume Next ' tells DB to move on when error is reached
Do
Call tInFocus
tFocus = tFocus + 1 'Adds tab (worksheet) in focus up one
Loop Until Err.Number <> 0 'breaks when no more worksheets available
MsgBox ("Data is fully copied.")
End Sub
Sub tInFocus()
cFocus = "Q" 'Sets the Column in focus to Column Q
rFocus = 5 'Sets the Row in focus to the fifth one
If rolandSource.Worksheets(tFocus).Range("Q4").Value = "" Then Exit Sub 'Ends subroutine if Q4 is empty, which means no data on this RoLanD tab
Do
Do
ThisWorkbook.Worksheets("1").Range("A" & rRecord).Value = rolandSource.Sheets(tFocus).Range("B" & rFocus) 'Copies employee number in focus to destination
ThisWorkbook.Worksheets("1").Range("B" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & "4") ' Copies learning title in focus to destination
ThisWorkbook.Wksheets("1").Range("C" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & rFocus) 'Copies learning completion date in focus to destination
ThisWorkbook.Worksheets("1").Range("D" & rRecord).Value = storeID 'Copies store ID to row in focus
rRecord = rRecord + 1 'Moves line being recorded to on one
cFocus = Chr(Asc(cFocus) + 1) 'Moves column in focus up one
Loop Until rolandSource.Worksheets(tFocus).Range(cFocus & 4) = "" 'Breaks loop when end column reached
rFocus = rFocus + 1 'Moves row in focus up one
cFocus = "Q" 'Resets cFocus to Column Q
Loop Until rolandSource.Worksheets(tFocus).Range(B & rFocus) = "" 'Breaks loop when end row reached
End Sub
我有两个问题；第一个是 Loop Until Err.Number <> 0 在第一个实例之后结束。当 tFocus 处于不存在工作表的值时，这应该结束循环。
第二个也是更大的问题是以下几行在调试 window:
If rolandSource.Worksheets(tFocus).Range("Q4").Value = "" Then Exit Sub
ThisWorkbook.Worksheets("1").Range("A" & rRecord).Value = rolandSource.Sheets(tFocus).Range("B" & rFocus) '将焦点中的员工编号复制到目的地
ThisWorkbook.Worksheets("1").Range("B" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & "4" ) ' 将焦点中的学习标题复制到目的地
ThisWorkbook.Wksheets("1").Range("C" & rRecord).Value = rolandSource.Worksheets(tFocus).Range(cFocus & rFocus) '将焦点中的学习完成日期复制到目的地
ThisWorkbook.Worksheets("1").Range("D" & rRecord).Value = storeID '将商店 ID 复制到焦点行
Loop Until rolandSource.Worksheets(tFocus).Range(cFocus & 4) = "" '到达结束列时中断循环
Loop Until rolandSource.Worksheets(tFocus).Range(B & rFocus) = "" '到达结束行时中断循环
我阅读了几篇文章并尝试了不同的方法，包括将复制数据的行更改为以下内容：
rolandSource.Activate
rolandSource.Worksheet(tFocus).Cell("B" & rFocus).Copy
ThisWorkbook.Activate
ThisWorkbook.Worksheet(1).Call("A" & rRecord).Paste
这产生了相同的结果。
如有任何想法或支持，我们将不胜感激。休息了很长时间后，我又开始写代码了，我知道我可能在做一些非常愚蠢的事情，但我想不通是什么！
感谢期待，丹
感谢@TimWilliams，他指出我没有正确声明我的变量。此外，使用 chr(asc 更改列的错误在 "z" 之后不起作用（显然当你考虑它时），所以我改为使用 cell().
进行引用