(21/03/2019, 23:57)haliliyas yazdı: Alt+F11 ile kod sayfasına girin
yeni bir modül ekleyip aşağıdaki kodu yapıştırın

Sub VeriBolSyf()
    Const lngNameCol = 1 ' verilerin alınacağı sütun KODların olduğu A sütünu
    Const lngFirstRow = 2 ' verilerin başladığı satır
    Dim wshSource As Worksheet
    Dim wshTarget As Worksheet
    Dim lngRow As Long
    Dim lngLastRow As Long
    Dim lngTargetRow As Long
    Application.ScreenUpdating = False
    Set wshSource = ActiveSheet
    lngLastRow = wshSource.Cells(wshSource.Rows.Count, lngNameCol).End(xlUp).Row
    For lngRow = lngFirstRow To lngLastRow
        If wshSource.Cells(lngRow, lngNameCol).Value <> wshSource.Cells(lngRow - 1, lngNameCol).Value Then
            Set wshTarget = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            wshTarget.Name = wshSource.Cells(lngRow, lngNameCol).Value
            wshSource.Rows(lngFirstRow - 1).Copy Destination:=wshTarget.Cells(1, 1)
            lngTargetRow = 2
        End If
        wshSource.Rows(lngRow).Copy Destination:=wshTarget.Cells(lngTargetRow, 1)
        lngTargetRow = lngTargetRow + 1
    Next lngRow
    Application.ScreenUpdating = True
End Sub

Kodu Seç

Kodu Kopyala

kod sayfasını kapatıp normal Excel sayfasına geçip
"görünüm" sekmesinde "makrolar" ı açıp "VeriBolSyf" seçin
dilerim işinize yarar.

desteğiniz için çoook teşekkür ediyorum..hemen deneyeceğim hocam