Application or object defined error in excel-vba - vba

Question

As you saw from the title I am getting error 1004. I am trying to make it iterate through cells B4 to B9 and at each one and if there is no sheet with the name in that cell it creates it and pastes the headers that are on the data entry page (C1:M3) and the data on that row from C to I onto the newly created sheet. If it does exist it looks at A1 of the sheet with that name and pastes the data into column B and the row that A1 specifies. And it does this for B4:B9 on each cell. Any help would be appreciated.
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
Here is what my data entry sheet looks like:
https://i.stack.imgur.com/NYo0P.png
Here is what the sheets that I am creating for each team look like:
https://i.stack.imgur.com/JaBfX.png

Answer 1

I've mocked this up here and tweaked your code to get it working. It isn't necessarily how I'd do it normally, (I wouldn't bother storing the destination row in A1 for instance - I'd detect the bottom and add there) but it works and should
a) make sense to you and
b) work with your data structure.
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