copy and create problem

[WERNER SLABBERT]

i have a workbook,( great start to a stupid problem)
problem is my code doesn't code ... ( stating the obvious) what is suppose to happen is:
when i enter data into sheet 2 the data should be visible in sheet 1 as a Catalogue form, aswell as when i enter new data on the next availeble row of sheet 2 it should create a new " item" on sheet 1 with the same formatting as the previous "item" in addition to that it should paste a corresponding image from a set folder to the prescribed block that was created.

now my code doesn't want to do any of that... PLEASE HELP...

Option Explicit ' Enforce explicit declaration

Sub CreateCatalogItem(ByVal Target As Range)
    On Error GoTo ErrHandler ' Enable error handling

    If Target.Worksheet.Name = "Sheet2" And Target.Row > 1 Then
        ' Check for data entry on Sheet2 (excluding header row)

        ' Find the next empty row on Sheet1
        Dim nextEmptyRow As Long ' More descriptive variable name
        nextEmptyRow = Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1

        ' Copy data from Sheet2 to Sheet1, aligning with headers
        Sheets("Sheet1").Cells(nextEmptyRow, 4).Value = Target.Cells(1, 1).Value ' Description to D1
        Sheets("Sheet1").Cells(nextEmptyRow + 3, 4).Value = Target.Cells(1, 2).Value ' Used in to D4
        Sheets("Sheet1").Cells(nextEmptyRow + 4, 4).Value = Target.Cells(1, 3).Value ' Price to D5
        Sheets("Sheet1").Cells(nextEmptyRow + 5, 4).Value = Target.Cells(1, 4).Value ' Code to D6

        ' Insert and paste image into the designated box
        Sheets("Sheet1").Pictures.Insert (Target.Cells(1, 5).Value) ' Insert image
        Dim imageData As Variant ' More descriptive variable name
        imageData = Selection.ShapeRange.Picture
        ActiveSheet.Range("A1:B6").PasteSpecial ' Paste into A1:B6 (adjust if needed)
        ActiveSheet.Pictures(ActiveSheet.Pictures.Count).CopyData imageData

        ' Optional: Delete the original image shape if desired
        ' Selection.ShapeRange.Delete

        ' Merge cells for description and image block (as previously specified)
        ' ... (Code for merging cells) ...

        ' Optional: Wrap text in description cells
        Sheets("Sheet1").Range("D" & nextEmptyRow & ":H" & (nextEmptyRow + 2)).WrapText = True

        ' Format price cells as currency
        Sheets("Sheet1").Range("D" & (nextEmptyRow + 4)).NumberFormat = "R#,##0.00"
    End If

Exit Sub ' Exit before error handler if no errors occur

ErrHandler:
    MsgBox "An error occurred: " & Err.Description, vbCritical, "Error in CreateCatalogItem"
End Sub