Run Time Error 1004 Hatası

[iplikci_80]

J Sütununa girilen tarihler ile o satır silinip ARŞİV sayfasına aktarılır iken aldığım hataların giderilmesi hususunda yardımlarınızı rica ediyorum.

 

[halit3]

Bu kodu bir dene

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bBuYuk As Long
Dim bBuyuk2 As Long
'Static a As Integer
Dim MyRange As Range, c As Range

Set MyRange = Intersect(Target, Range("B5:G1000"))
If Not MyRange Is Nothing Then
Application.EnableEvents = False

For Each c In MyRange
c.Value = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
Next c
Else

Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Application.EnableEvents = False: Application.DisplayAlerts = False
hcr = Target.Address(0, 0)
If Range(hcr).Column = 3 And Range(hcr).Row > 4 Then
Range("B" & Target.Row - 1 & ":J" & Target.Row - 1).Copy
Range("B" & Target.Row & ":J" & Target.Row).PasteSpecial Paste:=xlPasteFormats
    bBuYuk = WorksheetFunction.Max(Range("B5:B" & Cells(Rows.Count, 2).End(xlUp).Row))
    bBuyuk2 = WorksheetFunction.Max(Sheets("ARŞİV").Range("B5:B" & Sheets("ARŞİV").Cells(Rows.Count, 2).End(xlUp).Row))
    Cells(Range(hcr).Row, 2).Value = WorksheetFunction.Max(bBuYuk, bBuyuk2) + 1
    If Cells(Range(hcr).Row, 3) = "" Then Cells(Range(hcr).Row, 2) = ""
End If

Application.EnableEvents = 0
Range("B5:J" & Cells(Rows.Count, 2).End(3).Row).Sort [B4]
If Range(hcr).Column = 10 And Range(hcr).Row > 4 Then
    If Range(hcr).Value <> "" And IsDate(Range(hcr).Value) And Range(hcr).Value > DateSerial(Year(Date) - 1, 1, 1) Then
         aar = MsgBox(Cells(Target.Row, "B") & " " & Cells(Target.Row, "C") & " SİLİNECEK EMİN MİSİNİZ? ", vbYesNo)
         If aar = vbNo Then GoTo 10
    
            asat = Sheets("ARŞİV").Cells(Rows.Count, 2).End(3).Row + 2
            Range("B" & Range(hcr).Row & ":J" & Range(hcr).Row).Copy Sheets("ARŞİV").Cells(asat, 2)
            Sheets("ARŞİV").Range("B5:J" & asat).Sort Sheets("ARŞİV").[B5]
            Range("B" & Range(hcr).Row & ":J" & Range(hcr).Row).Delete Shift:=xlUp
 
        
        
    Else
        Range(hcr).Value = Empty
    End If
    Application.EnableEvents = 1
End If
If hcr = "K3" Or hcr = "L3" Then
If [K3] <> "" And [L3] <> "" And IsDate([K3]) = True And IsDate([L3]) = True And [K3] <= [L3] Then
    Call Rapor
End If
End If

End If
bitir:

10:
Application.DisplayAlerts = True: Application.EnableEvents = True
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

End Sub

 

[Greenblacksea53]

Dim MyRange As Range, c As Range
On Error GoTo handlr
Set MyRange = Intersect(Target, Range("B5:G1000"))
If Not MyRange Is Nothing Then
    Application.EnableEvents = False
    On Error GoTo handlr
    For Each c In MyRange
        c.Value = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
    Next c
End If
handlr:
Application.DisplayAlerts = True: Application.EnableEvents = True
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
'If Target.Column = 3 Then Cells(Rows.Count, 3).End(3).Select

bu şekilde hata almadım