应用程序定义或对象定义错误（1004）-Excel VBA_Vba_Excel

应用程序定义或对象定义错误（1004）-Excel VBA

vba excel

应用程序定义或对象定义错误（1004）-Excel VBA,vba,excel,Vba,Excel,我有一个名为“EvaluationLog.xlsm”的工作簿，我需要将特定单元格（不是整行）从第一个工作表转移到位于同一目录中的另一个名为“IndicatorLog.xlsm”的现有工作簿。目标工作表也是第一个工作表。我正在尝试将宏托管在“IndicatorLog”工作簿中仅当“O”列的内容为“否”或“J”列的内容为“初始”时，才复制源中每行中的特定单元格。实际源数据从第8行开始，目标范围也从第8行开始我有两个问题。第一个问题是，我在试图复制单元格的第一行得到了这个错误“应用程序定义的或对象

我有一个名为“

EvaluationLog.xlsm

”的工作簿，我需要将特定单元格（不是整行）从第一个工作表转移到位于同一目录中的另一个名为“

IndicatorLog.xlsm

”的现有工作簿。目标工作表也是第一个工作表。我正在尝试将宏托管在“

IndicatorLog

”工作簿中

仅当“O”列的内容为“否”或“J”列的内容为“初始”时，才复制源中每行中的特定单元格。实际源数据从第8行开始，目标范围也从第8行开始

我有两个问题。第一个问题是，我在试图复制单元格的第一行得到了这个错误“应用程序定义的或对象定义的错误（1004）”

这是一行：

TargetSheet.Range（“A”&NRow）.Value=WorkBk.ActiveSheet.Range（“A”&i）.Value

第二个问题是，当我已经打开了源工作簿时，我会收到一条关于再次尝试打开该工作簿的警告，尽管我有一个函数可以避免这样做：(

我将宏分配给表单按钮。如有任何帮助，将不胜感激！：）

以下是两个Excel文件：

代码如下：

Sub MergeFromLog()

Dim TargetSheet As Worksheet
Dim NRow As Long
Dim SourceFileName As String
Dim WorkBk As Workbook
Dim LastRow As Integer, i As Integer, erow As Integer

' Set destination file.
Set TargetSheet = ActiveWorkbook.Worksheets(1)

' Set source file.
SourceFileName = ActiveWorkbook.Path & "\2015-2016 Evaluation Log.xlsm"

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 8

' Open the source workbook in the folder
If CheckFileIsOpen(SourceFileName) = False Then
    Set WorkBk = Workbooks.Open(SourceFileName)
Else
    Set WorkBk = Workbooks(SourceFileName)
End If

LastRow = WorkBk.ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row

For i = 8 To LastRow

    If WorkBk.ActiveSheet.Range("O" & i) = "No" Or WorkBk.ActiveSheet.Range("J" & i) = "Initial" Then

        ' Copy Student Name
        TargetSheet.Range("A" & NRow).Value = WorkBk.ActiveSheet.Range(“A” & i).Value
        ' Copy DOB
        TargetSheet.Range("B" & NRow).Value = WorkBk.ActiveSheet.Range(“C” & i).Value
        ' Copy ID#
        TargetSheet.Range("C" & NRow).Value = WorkBk.ActiveSheet.Range(“D” & i).Value
        ' Copy Consent Day
        TargetSheet.Range("D" & NRow).Value = WorkBk.ActiveSheet.Range(“L” & i).Value
        ' Copy Report Day
        TargetSheet.Range("E" & NRow).Value = WorkBk.ActiveSheet.Range(“N” & i).Value
        ' Copy FIE within District Timelines?
        TargetSheet.Range("F" & NRow).Value = WorkBk.ActiveSheet.Range(“O” & i).Value
        ' Copy Qualified?
        TargetSheet.Range("H" & NRow).Value = WorkBk.ActiveSheet.Range(“A” & i).Value
        ' Copy Primary Eligibility
        TargetSheet.Range("I" & NRow).Value = WorkBk.ActiveSheet.Range(“U” & i).Value
        ' Copy ARD Date
        TargetSheet.Range("J" & NRow).Value = WorkBk.ActiveSheet.Range(“R” & i).Value
        ' Copy ARD within District Timelines?
        TargetSheet.Range("K" & NRow).Value = WorkBk.ActiveSheet.Range(“S” & i).Value
        ' Copy Ethnicity
        TargetSheet.Range("M" & NRow).Value = WorkBk.ActiveSheet.Range(“F” & i).Value
        ' Copy Hisp?
        TargetSheet.Range("N" & NRow).Value = WorkBk.ActiveSheet.Range(“G” & i).Value
        ' Copy Diag/LSSP
        TargetSheet.Range("O" & NRow).Value = WorkBk.ActiveSheet.Range(“X” & i).Value

        NRow = NRow + 1

    End If

Next i

End Sub

Function CheckFileIsOpen(chkSumfile As String) As Boolean

On Error Resume Next

CheckFileIsOpen = UCase(Workbooks(chkSumfile).Name) Like UCase(chkSumfile)

On Error GoTo 0

End Function

更改函数调用：

Function CheckFileIsOpen(chkSumfile As String) As Boolean
Dim ret 
ret = False
On Error Resume Next

ret = (Workbooks(chkSumfile).Name <> "")

CheckFileIsOpen = ret

End Function

函数CheckFileIsOpen（chkSumfile作为字符串）作为布尔值
暗网
ret=假
出错时继续下一步
ret=（工作簿（chkSumfile.Name“”）
CheckFileIsOpen=ret
端函数

否则，具有讽刺意味的智能引号在VBA中不起作用（或者根本不起作用）。将它们固定到正常的引号应该注意。

您可以利用很少使用的带有错误控制的

Resume

Sub MergeFromLog2()

    Dim SourceSheet As Worksheet, TargetSheet As Worksheet
    Dim SourceFileName As String
    Dim LastRow As Long, i As Long, NRow As Long

    ' Set destination file.
    Set TargetSheet = ThisWorkbook.Worksheets(1)
    NRow = TargetSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1

    ' Set source file.
    On Error GoTo CheckWbIsOpen
    SourceFileName = ThisWorkbook.Path & "\2015-2016 Evaluation Log.xlsm"
    'Try to work on it as if it was open. If it is closed an error will be thrown and it will be opened and control will be returned back here
    Set SourceSheet = Workbooks(Trim(Right(Replace(SourceFileName, "\", Space(99)), 99))).Worksheets(1)
    On Error GoTo 0

    With SourceSheet
        Debug.Print .Name
        LastRow = .Cells(Rows.Count, "A").End(xlUp).Row

        For i = 8 To LastRow
            If .Range("O" & i) = "No" Or .Range("J" & i) = "Initial" Then

                ' Copy Student Name
                TargetSheet.Range("A" & NRow).Value = .Range("A" & i).Value
                ' Copy DOB
                TargetSheet.Range("B" & NRow).Value = .Range("C" & i).Value
                ' Copy ID#
                TargetSheet.Range("C" & NRow).Value = .Range("D" & i).Value
                ' Copy Consent Day
                TargetSheet.Range("D" & NRow).Value = .Range("L" & i).Value
                ' Copy Report Day
                TargetSheet.Range("E" & NRow).Value = .Range("N" & i).Value
                ' Copy FIE within District Timelines?
                TargetSheet.Range("F" & NRow).Value = .Range("O" & i).Value
                ' Copy Qualified?
                TargetSheet.Range("H" & NRow).Value = .Range("A" & i).Value
                ' Copy Primary Eligibility
                TargetSheet.Range("I" & NRow).Value = .Range("U" & i).Value
                ' Copy ARD Date
                TargetSheet.Range("J" & NRow).Value = .Range("R" & i).Value
                ' Copy ARD within District Timelines?
                TargetSheet.Range("K" & NRow).Value = .Range("S" & i).Value
                ' Copy Ethnicity
                TargetSheet.Range("M" & NRow).Value = .Range("F" & i).Value
                ' Copy Hisp?
                TargetSheet.Range("N" & NRow).Value = .Range("G" & i).Value
                ' Copy Diag/LSSP
                TargetSheet.Range("O" & NRow).Value = .Range("X" & i).Value

                NRow = NRow + 1

            End If

        Next i
        Application.DisplayAlerts = False
        .Parent.Close False
    End With

    GoTo Safe_Exit
CheckWbIsOpen:
    i = i + 1
    If i > 1 Then
        'tried once and failed - do not keep trying to open something that doesn't want to be opened
        Debug.Print "Unable to open: " & SourceFileName
        Exit Sub
    End If
    Workbooks.Open Filename:=SourceFileName, ReadOnly:=True
    Resume  '<- this sends control back to the line that threw the error
Safe_Exit:
    Set SourceSheet = Nothing
    Set TargetSheet = Nothing
    Application.DisplayAlerts = True
End Sub

Sub-MergeFromLog2（）
将源工作表设置为工作表，将目标工作表设置为工作表
将SourceFileName设置为字符串
最后一行一样长，我一样长，我一样长
'设置目标文件。
Set TargetSheet=ThisWorkbook.工作表（1）
NRow=TargetSheet.Cells（Rows.Count，1）。End（xlUp）。Row+1
'设置源文件。
关于错误转到CheckWbIsOpen
SourceFileName=ThisWorkbook.Path&“\2015-2016评估日志.xlsm”
“试着把它当作是开着的。如果它被关闭，将抛出一个错误，并将其打开，控制权将返回此处
设置SourceSheet=工作簿（修剪（右侧（替换（SourceFileName，“\”，空格（99）），99）））。工作表（1）
错误转到0
使用源代码表
Debug.Print.Name
LastRow=.Cells（Rows.Count，“A”）.End（xlUp）.Row
对于i=8到最后一行
如果.Range（“O”&i）=“否”或.Range（“J”&i）=“初始值”，则
“复制学生姓名
TargetSheet.Range（“A”&NRow）.Value=.Range（“A”&i）.Value
“收到，杜布
TargetSheet.Range（“B”和NRow）.Value=.Range（“C”和i）.Value
'复制ID#
TargetSheet.Range（“C”和NRow）.Value=.Range（“D”和i）.Value
“复制同意日”
TargetSheet.Range（“D”和NRow）.Value=.Range（“L”和i）.Value
"抄报日"
TargetSheet.Range（“E”和NRow）.Value=.Range（“N”和i）.Value
'在地区时间表内复制FIE？
TargetSheet.Range（“F”和NRow）.Value=.Range（“O”和i）.Value
“复印件合格吗？
TargetSheet.Range（“H”和NRow）.Value=.Range（“A”和i）.Value
'复制主要资格
TargetSheet.Range（“I”和NRow）.Value=.Range（“U”和I）.Value
“抄送日期
TargetSheet.Range（“J”和NRow）.Value=.Range（“R”和i）.Value
'在地区时间表内复制ARD？
TargetSheet.Range（“K”和NRow）.Value=.Range（“S”和i）.Value
"复制种族",
TargetSheet.Range（“M”和NRow）.Value=.Range（“F”和i）.Value
“听到嘶嘶声了吗？
TargetSheet.Range（“N”和NRow）.Value=.Range（“G”和i）.Value
'复制诊断/LSSP
TargetSheet.Range（“O”和NRow）.Value=.Range（“X”和i）.Value
NRow=NRow+1
如果结束
接下来我
Application.DisplayAlerts=False
.Parent.Close错误
以
转到安全出口
检查wbisopen：
i=i+1
如果i>1，那么
“尝试过一次但失败了-不要继续尝试打开不想打开的东西
Debug.Print“无法打开：”&SourceFileName
出口接头
如果结束
工作簿。打开文件名：=源文件名，只读：=真
Resume“我认为，CheckFileIsOpen
不会满足您的要求。也许可以改为尝试。尝试修复您的语法“A”
-应该是“A”
，可以修复您的错误（1004）“智能引号”不能很好地使用VBA:）谢谢，谢谢，谢谢！！！！：）@克劳迪亚洛雷娜别忘了帮你解决这个问题，非常感谢！！：）我能够运行宏，它确实复制了单元格，但它们转到了目标工作簿的最后一行。我用这个NRow=8替换了这个NRow=TargetSheet.Cells（Rows.Count，1）。End（xlUp）。Row+1，它成功了！再次感谢！：）：）。很抱歉重写了目标行。没问题。加油！！非常非常感谢！：）