发生以下错误：应用程序定义的或对象定义的错误1004 VBAProject

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 

所以，当我尝试和运行这从你看到的标题我得到一个应用程序定义或对象定义的错误：1004我试图使它遍历单元格B4到B9和每一个，如果没有工作表用该单元格中的名称创build它，并将数据input页面（C1：M3）上的标题以及C到I这一行上的数据粘贴到新创build的表单上。 如果它确实存在，它将查找具有该名称的工作表的A1，并将数据粘贴到列B和A1指定的行中。 它在每个单元格上为B4：B9执行此操作。 任何帮助，将不胜感激。

Answer 1

Dim teamdata As String

stringcombine = "C" & countery & ":" & "M" & countery

teamdata = Range(stringcombine)

在这里，您将一个数组（11个条目）分配给一个string，因此types不匹配 。

在阅读你的代码后，你的意思是做什么

 teamdata = Range(stringcombine).Address 

虽然没有必要为地址创build一个额外的variablesteamdata ，但您已经在stringcombine了它。

Answer 2

看看copypaste函数，看起来inputRange参数应该有一个像“C3：M3”这样的string值。 您将teamdata传递给copypaste作为input范围参数，那么您是否期待teamdata具有类似“C3：M3”的值？ 如果是这样，那么你的线

 teamdata = Range(stringcombine) 

可能

 teamdata = stringcombine 

当前行尝试执行的操作是从单元格范围中取值，并将它们分配给一个stringvariables – 这不是它devise的目的。 如果stringcombine类似“M3”，它会工作正常。 一个单元格值为一个string。

Answer 3

错误13通常意味着你正试图给一个不能接受该数据types的variables赋值，或者你试图将错误的数据types作为parameter passing给一个子或函数。

如果我已经理解了你的要求，这应该能够代替你现有的代码：

 Sub AddData_ReWrite() Dim teamName As String Dim i As Integer Dim matchCounter As String Dim dataEntry As Excel.Worksheet matchCounter = Range("A1").Value Set dataEntry = Sheets("DataEntry") For i = 4 To 9 teamName = Sheets("DataEntry").Range("B" & i).Value CreateSheetIfNotExists teamName Sheets(teamName).Range("B" & matchCounter & ":N" & matchCounter).Value = dataEntry.Range("C" & i & ":M" & i).Value Next dataEntry.Activate End Sub Sub CreateSheetIfNotExists(ByVal sheetName As String) Dim sht As Worksheet On Error GoTo ErrHandler: Set sht = Sheets(sheetName) ErrHandler: If (Err.Number) Then If Err.Number = 9 Then With Worksheets.Add .Name = sheetName .Range("B1:N3").Value = Sheets("DataEntry").Range("C1:M3").Value .Range("A1").Value = 2 End With Else '// What if it isn't error 9? MsgBox "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description, vbExclamation + vbOKOnly, "Error" End If End If '// clear errors and reset error handler Err.Clear On Error GoTo 0 End Sub 

为了提高可读性并在其他子程序中增加额外的error handling，我整理了一下。