vba drag and drop kullanınca type mismatch hatası alıyorum

[sedasedadmr]

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.column = 6 Then
For Each cell In Target

If Target.column = 6 And Target.Value <> Empty Then
Target.Offset(0, -1) = Format(Mid(Target, 5, 4))
Target.Offset(0, -2) = Format(Mid(Target, 3, 1))
Target.Offset(0, -3) = Format(Left(Target, 2))

End If

If Target.column = 6 And Target.Value = "" Then
Target.Offset(0, -1).ClearContents
Target.Offset(0, -2).ClearContents
Target.Offset(0, -3).ClearContents
End If

Next cell
End If
End Sub


böyle bir kod kullanıyorum. ama hedef kolonda bazen drag and drop kullanılması gerekiyor yani veriyi aşağıya doğru çekip kopyaladığımda type mismatch hatsı alıyorum. Yardımcı olursanız çok sevinirim

 

[Korhan Ayhan]

Merhaba,

Döngü içinde yazdığınız TARGET ifadelerini cell olarak değiştirmelisiniz.

'Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 6 Then
        For Each cell In Target
            If cell.Column = 6 And cell.Value <> Empty Then
                cell.Offset(0, -1) = Format(Mid(cell, 5, 4))
                cell.Offset(0, -2) = Format(Mid(cell, 3, 1))
                cell.Offset(0, -3) = Format(Left(cell, 2))
            End If
        
            If cell.Column = 6 And cell.Value = "" Then
                cell.Offset(0, -1).ClearContents
                cell.Offset(0, -2).ClearContents
                cell.Offset(0, -3).ClearContents
            End If
        Next cell
    End If
End Sub