Arkadaşlar merhaba,
Ekli örnek dosyada mevcut A sütunundaki "KOD"  bilgileri aynı olan verileri KOD ismi ile aynı olacak
şekilde sayfalara ayırmak istiyorum.
Konuyla ilgili bilgi ve yardımlarınızı rica ediyorum.
Saygılarımla,

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

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.

(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

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

olumlu yada olumsuz sonucu bildirir misiniz?