Skip to main content

AccessTr.neT M.


Verileri Sayfalara Ayırma

Verileri Sayfalara Ayırma

Çözüldü #1
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,

.rar sayfalara_ayırma.rar (Dosya Boyutu: 7,6 KB | İndirme Sayısı: 3)
amelie, 09-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#2
Alt+F11 ile kod sayfasına girin
yeni bir modül ekleyip aşağıdaki kodu yapıştırın

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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.

.rar sayfalara_ayırma.rar (Dosya Boyutu: 11,33 KB | İndirme Sayısı: 6)
Cevapla
...........
Heart #3
(21/03/2019 23:57)haliliyas Adlı Kullanıcıdan Alıntı: Alt+F11 ile kod sayfasına girin
yeni bir modül ekleyip aşağıdaki kodu yapıştırın

Visual Basic Code
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
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

amelie, 09-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#4
olumlu yada olumsuz sonucu bildirir misiniz?

Cevapla
...........

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da