Copy Ranges not containing exceptions - excel

Question

I have a macro that is supposed to identify cells containing data in a column, and then copy multiple columns from said cells row into another worksheet.
19 rows that fit the Criteria to be copied (and don't contain any words that come up in my 5 exceptions) aren't being copied.
I tried to go through the macro step by step, working with stopping points and changing around the macro itself.
My theory is there is something wrong with the Cells in the sheet it is supposed to copy from.
Sub Copy_Range()
Dim zelle, cell As Range
Dim i As Long
On Error Resume Next
Worksheets("Worksheet 4").Activate
Application.GoTo Worksheets("Worksheet 4").Range("C2:H1000")
Application.ScreenUpdating = False
Worksheets("Worksheet 4").Activate
Range("C2:C1000,D2:D1000,E2:E1000,F2:F1000,G2:G1000,H2:H1000").Clear
Worksheets("Worksheet 1").Activate
Range("A6").Activate
'This part Shows an alert when theres no Data entered in column A
If WorksheetFunction.CountA(Range("A6:A1000")) = 0 Then
Dim click As Integer
click = MsgBox(prompt:="There was no data Entered in Column A", Buttons:=vbExclamation)
Cells(1, 1).Select
Exit Sub
End If
Set Tbl2 = ThisWorkbook.Worksheets("Worksheet 1").ListObjects("Tabelle33")
LastRow4 = Tbl2.ListColumns(1).Range.Rows.Count
Set cell = Cells(ActiveCell.Row, ActiveCell.column)
'This part is supposed to look through Column A in Worksheet 1
'If there is data entered in column A of a row the Macro copies the data entered in column 1, 2, 3, 5, 6 and 7 of that row into Worksheet 4,
'UNLESS the Data entered in Column A is one of 5 exceptions.
For Each zelle In Worksheets("Worksheet 1").Range(Cells(Rows.Count, cell.column), Cells(cell.Row, cell.column))
If ActiveCell.Value = "" Then
Selection.End(xlDown).Select
**ElseIf ActiveCell.Value = "Exception 1" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 2" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 3" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 4" Then**
**Selection.End(xlDown).Select**
**ElseIf ActiveCell.Value = "Exception 5" Then**
**Selection.End(xlDown).Select**
Else
Union(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row, 2), Cells(ActiveCell.Row, 3), Cells(ActiveCell.Row, 5), Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row, 7)).Copy
Application.GoTo Worksheets("Worksheet 4").Cells(2, 3)
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Selection.PasteSpecial Paste:=xlPasteAll
Range("C2:H2").Select
Selection.Insert Shift:=xlDown
Worksheets("Worksheet 1").Activate
ActiveCell.Offset(1, 0).Select
End If
Next
Worksheets("Worksheet 4").Activate
Range("C2:H1000").Interior.Color = xlNone
End Sub
Edit: the problem seems to be the ** Starred ** lines in my code aka. my "Exceptions"
I have since removed that snippet and am working on a new bit of code that filters through column A and then deletes the Exceptions after the fact, instead of not copying them from the start.

Answer 1

You are missing Dim zelle AS RANGE
While defining variables on the same line each varaible must be defined separately so
Dim zelle as range, cell as range
Also try
replacing If ActiveCell.Value by If zelle.value

Answer 2

Try this code:
Dim LR as long
Dim cell as range
LR = Thisworkbook.worksheets("name of your worksheet").range("A" & rows.count).end(xlup).row
for cell in range("A1","A"& LR)
if cell.value =
'add here all your exceptions scenarios
else
'copy the data code
end if
next cell