excel vba中的应用程序或对象定义错误

正如你从标题中看到的，我得到了错误1004。我试图让它遍历单元格B4到B9，在每个单元格中，如果该单元格中没有具有名称的工作表，它将创建它，并将数据输入页（C1:M3）上的标题和该行上从C到I的数据粘贴到新创建的工作表上。如果确实存在，则查看具有该名称的图纸的A1，并将数据粘贴到列B和A1指定的行中。它对每个电池上的B4:B9都这样做。任何帮助都将不胜感激

Function copyHeader(inputrange As String, inputsheet As String, outputcell As String, outputsheet As String)
    Sheets(inputsheet).Range(inputrange).Copy Destination:=Sheets(outputsheet).Range(outputcell)
    Application.CutCopyMode = False
    Cells(1, 1).Value = 4  'probably better to make this dynamic
End Function

Function copyDetail(inputrange As String, inputsheet As String, outputcell As String, outputsheet As String)
    Sheets(inputsheet).Range(inputrange).Copy Destination:=Sheets(outputsheet).Range(outputcell)
    Application.CutCopyMode = False
    Cells(1, 1).Value = 4  'probably better to make this dynamic
End Function

Function createTab(tabname As String)
    Worksheets.Add.Name = tabname
End Function

Function shtExists(shtname As String) As Boolean
    Dim sht As Worksheet
    On Error GoTo ErrHandler:
    Set sht = Sheets(shtname)
    shtExists = True
ErrHandler:
    If Err.Number = 9 Then
        shtExists = False
    End If
End Function

Public Function lastCell(Col As String)
    With ActiveSheet
        lastCell = .Cells(.Rows.Count, Col).End(xlUp).Row
    End With
End Function

Sub AddData()
    Dim teamname As String
    Dim countery As Integer
    Dim teamdata As String
    Dim matchcounter As String
    Dim resp As Boolean
    Dim maxCounter As Integer

    counter = 4
    maxCounter = lastCell("B")

    On Error GoTo eh
    For counter = 4 To maxCounter
        ThisWorkbook.Sheets("DataEntry").Select
        teamdata = "C" & counter & ":" & "N" & counter
        teamname = ThisWorkbook.Sheets("DataEntry").Range("B" & counter).Value

    resp = shtExists(teamname)

    If resp = False Then
        createTab (teamname)

        copyHeader "C1:M3", "DataEntry", "B1", teamname
        matchcounter = CStr(Sheets(teamname).Range("A1").Value)
        copyDetail teamdata, "DataEntry", "B" & matchcounter, teamname

    ElseIf resp = True Then
        copyDetail teamdata, "DataEntry", "B" & matchcounter, teamname
    End If
    Next counter

Worksheets("DataEntry").Activate
Done:
    Exit Sub
eh:
    MsgBox "The following error occurred: " & Err.Description & " " & Err.Number & " " & Err.Source
End Sub

以下是我的数据输入表：

以下是我为每个团队创建的工作表：

---

我在这里模拟了这一点，并调整了您的代码以使其正常工作。这不一定是我通常的做法（例如，我不会费心将目标行存储在A1中——我会检测底部并添加到那里），但它是有效的，应该是这样的

a） 对你和我都有意义

b） 使用您的数据结构

Option Explicit
Sub copyHeader(inputrange As String, inputsheet As String, outputcell As String, outputsheet As String)
    Sheets(inputsheet).Range(inputrange).Copy Destination:=Sheets(outputsheet).Range(outputcell)
    Application.CutCopyMode = False
    Cells(1, 1).Value = 4  'probably better to make this dynamic
End Sub

Sub copyDetail(inputrange As String, inputsheet As String, outputcell As String, outputsheet As String)
    Sheets(inputsheet).Range(inputrange).Copy Destination:=Sheets(outputsheet).Range(outputcell)
    Application.CutCopyMode = False
    Sheets(outputsheet).Cells(1, 1).Value = Sheets(outputsheet).Cells(1, 1).Value + 1
End Sub

Sub createTab(tabname As String)
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = tabname
End Sub

Function shtExists(shtname As String) As Boolean
    Dim sht As Worksheet
    On Error GoTo ErrHandler:
    Set sht = Sheets(shtname)
    shtExists = True
ErrHandler:
    If Err.Number = 9 Then
        shtExists = False
    End If
End Function

Public Function lastCell(sht As Worksheet, Col As String)
    With sht
        lastCell = .Cells(.Rows.Count, Col).End(xlUp).Row
    End With
End Function

Sub AddData()
    Dim teamname As String
    Dim counter As Integer
    Dim teamdata As String
    Dim matchcounter As String
    Dim resp As Boolean
    Dim maxCounter As Integer
    Dim sourcesheet As Worksheet
    counter = 4
    Set sourcesheet = ThisWorkbook.Sheets("DataEntry")
    maxCounter = lastCell(sourcesheet, "B")

    On Error GoTo eh
    For counter = 4 To maxCounter
        sourcesheet.Select
        teamdata = "C" & counter & ":" & "N" & counter
        teamname = sourcesheet.Range("B" & counter).Value

    resp = shtExists(teamname)

    If resp = False Then
        createTab (teamname)

        copyHeader "C1:M3", sourcesheet.Name, "B1", teamname
        matchcounter = CStr(Sheets(teamname).Range("A1").Value)
        copyDetail teamdata, sourcesheet.Name, "B" & matchcounter, teamname

    ElseIf resp = True Then
        matchcounter = CStr(Sheets(teamname).Range("A1").Value)
        copyDetail teamdata, sourcesheet.Name, "B" & matchcounter, teamname
    End If
    Next counter

Worksheets("DataEntry").Activate
Done:
    Exit Sub
eh:
    MsgBox "The following error occurred: " & Err.Description & " " & Err.Number & " " & Err.Source
End Sub

---

你在哪一行收到错误？如果您注释（或删除）错误处理程序，它会向您显示什么？您确实应该通过记录错误发生的行来帮助我们。但是，如果工作表（teamname）不存在，我会在“createTab（teamname）”行上看到您的错误。寻求调试帮助的问题（“为什么此代码不起作用？”）必须包括所需的行为、特定的问题或错误以及在问题本身中重现它所需的最短代码。没有明确问题陈述的问题对其他读者没有用处。请看。当处理thexists（）的if语句等于true时，我得到了错误。请注意细节——这真的很重要！你没有所谓的“超现实主义者”这是“超现实主义者”