• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

süz aktar

D

dennisf06

Katılım
28 Nisan 2008
Mesajlar
406
Excel Vers. ve Dili
Excel 2007- Türkce
merhaba,

satir14 ten sonra ( A,C,E sütunlarinda ) süzme islemi yapiyorum. süzme islemi sonucunu sayfa2 ye aktarmak icin asagidaki kodu siteden bulup uyarlamaya calistim. aktarma islemi yap diye butona bastigimda sayfa1 deki veriler siliniyor. sayfa1 deki veriler ayni kalsin vede sadece istedigim sütunlari sayfa2 ye aktarmak istiyorum. tesekkür ederim.

Sub Makro1()
sutun = "A" & "#" & "C" & "#" & "E" & "#" & "F" & "#" & "G" & "#" & "H" & "#" & "I" & "#" & "AU" & "#" & "AW" & "#" & "CI"
sutun = Split(sutun, "#")
say = UBound(sutun)
For i = 0 To say
Sheets("Data List").Columns(sutun(i)).AutoFilter Field:=1, Criteria1:="<>"
Sheets("Data List").Columns(sutun(i)).Copy
Sheets("Sayfa1").Columns(i + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Data List").Columns(sutun(i)).AutoFilter
Next
End Sub
 
Merhaba,

Aşağıdaki kodları inceleyiniz. Aktif sayfada süzülmüş veriyi Sayafa1'e aktarır. B,C ve F sütunları siler. Kodları kendinize uyarlayınız.

Kod: 
Sub Aktar()

    Dim Syf As Worksheet
    Dim c1
    
    With ActiveSheet
        If .AutoFilterMode Then
            With .AutoFilter.Filters(1)
                If .On Then c1 = .Criteria1
            End With
        End If
    End With
    
    If c1 = Empty Then
        MsgBox "Süzme Yokki Neyi Aktarayım?"
        Exit Sub
    End If
    
    Set Syf = Sheets("Sayfa1")
    
    Syf.Cells.ClearContents
    
    Range("A1").CurrentRegion.Copy Syf.Range("A1")
    
    Syf.Range("B:B,C:C,F:F").Delete Shift:=xlToLeft
    
End Sub
 
merhaba Necdet Hocam,

kodu kendime uyarlamaya calistim. su problemlerle karsilastim.

1- sadece A sütunuda süzme yapinca aktarma yapiyor. sadece C tütununda veya E sütununda süzme yapinca süzme yokki uyarisi veriyor.
2-süzme yapilan satirin sadece bir kac sütununda bilgileri aktariyor. komple satir boyunca olan bilgileri aktarmak arada benim belirleyecegim sütunlari devreden cikarmak istiyorum. yukardaki kodda dediginiz gibi yaptim olmadi. tesekkür ederim.
 
hocam merhaba

bir düzeltme yapmak istiyorum. kod sadece süzme yapilan sütunlari aktariyor. ben A, C, E sütunlarinda süzme yaptiktan sonra örnegin H,G,I,M sütunlarinda degerler var. yani ayni satir boyunca aktarilacak zannettim. kusura bakmayin.
 
Sayın dennis06
dosya.tc gibi bir dosya paylaşım sitesine örnek dosya eklerseniz. çabuk ve kesin cevap alırsınız.
 
Benim ofis 2003, dosyanızı açarken vba kodları siliniyor.
Hangi sütunda, hangi kritere göre süzeceksiniz.
Sayfadaki metin kutu düğmeler ne işe yarayacak
Sayfa 1 e hangi sütunlar aktarılacak bunu nasıl belirleyeceksiniz
 
merhaba alicimri bey,

A sütununda iki tarih arasi süzme, C ve E sütununda metin süzmesi yapiyorum. herhangi bir veya ayni anda iki süzme sonucunu sayfa 2 ye aktarmak istiyorum. butonlardan biri iki tarih arasi süzme icin birinide Levent hocamizin kodlari icin kullandim. süzme sonucunda komple satirlari veya yapilabilirse benim belirleyebilecegim sütunlari aktarmak istiyorum.tesekkürler.
 
Süzme işlemi bittikten sonra kodu çalıştırın
Kod: 
Sub Aktar()
say = Range("A65536").End(3).Row
Range("A16:N" & say).Copy
say2 = Sheets("Sayfa1").Range("A65536").End(3).Row
 Sheets("Sayfa1").Range("A" & say2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
 False, Transpose:=False
End Sub
 
dennisf06' Alıntı:
merhaba Necdet Hocam,

kodu kendime uyarlamaya calistim. su problemlerle karsilastim.

1- sadece A sütunuda süzme yapinca aktarma yapiyor. sadece C tütununda veya E sütununda süzme yapinca süzme yokki uyarisi veriyor.
2-süzme yapilan satirin sadece bir kac sütununda bilgileri aktariyor. komple satir boyunca olan bilgileri aktarmak arada benim belirleyecegim sütunlari devreden cikarmak istiyorum. yukardaki kodda dediginiz gibi yaptim olmadi. tesekkür ederim.
Genişletmek için tıkla ...

Aşağıdaki kodları verdiğim kodlardan silin.
Kod: 
    With ActiveSheet
        If .AutoFilterMode Then
            With .AutoFilter.Filters(1)
                If .On Then c1 = .Criteria1
            End With
        End If
    End With
    
    If c1 = Empty Then
        MsgBox "Süzme Yokki Neyi Aktarayım?"
        Exit Sub
    End If

Bazı kolanları silecem dediniz ben aşağıdaki kodu örnek olarak verdim.

Kod: 
    Syf.Range("B:B,C:C,F:F").Delete Shift:=xlToLeft

bu kodu da silin

sonuçta süz yaptıktan sonra geriye kalanı aktarır.

Kodları biraz kurcalasanız sonuca ulaşabilirdiniz diye düşünüyorum.
 
süzme isleminden sonra sayfa1 e aktariyor fakat yeni süzme isleminde eski süzme bilgileri bir önceki sayfada kalip altina kopyalayarak geliyor. her yeni süzme yeni bir rapor olmali.tesekkür ederim.
 
Merhaba,
Set Syf = Sheets("Sayfa1")

ile Syf değerine "sayfa1" i aktarıyoruz. Siz bunu kendi sayfa adını vereceksiniz. Yani aktaracağınız sayfanın adı Ahmet ise Set Syf=sheets("Ahmet") yazacaksınız.

dolayısıyla aktaracağı sayfayı zaten siliyor.
 
Sub Aktar()

Dim Syf As Worksheet
Dim c1

Set Syf = Sheets("Sayfa1")

Syf.Cells.ClearContents

Range("A1").CurrentRegion.Copy Syf.Range("A1")

Syf.Range("B:B,C:C,F:F").Delete Shift:=xlToLeft

End Sub

sildikten sonraki son hali yukardaki gibi oldu. bir islev yapmadi. kod bilgim zayif oldugu icin ne unuttum bilmiyorum.
 
hocam süzme islemini sayfa1 de yapiyorum sayfa2 ye aktarmak istiyorum. bu arada halen ugrasmaktayim. cözümü bulacagim insallah.
 
hocam isin icinden cikamiyorum.yardimlarinizi bekliyorum. tesekkür ederim.
 
Eklediğiniz dosyada süzme işleminden sonra hangi sütunları "Sayfa1" isimli sayfaya aktarmak istiyor sunuz?

"Ana" isimli sayfanızda 8. satırı sildikten sonra aşağıdaki kod ile aktarım işlemini yapabilirsiniz.

Kod: 
Sub Aktar()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Tarih_1 As Date, Tarih_2 As Date, Son As Long
    
    Set S1 = Sheets("Ana")
    Set S2 = Sheets("Sayfa1")
    
    S2.Cells.Delete
    
    If S1.AutoFilterMode Then
        Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
        S1.Range("A7:N" & Son).Copy S2.Range("A1")
    End If
End Sub
 
Eklediğiniz dosyada önerdiğim kodlar çalışıyor.
 
hocam ben de ilk süzmede calisti. pes pese degisik süzmeler yaptiktan sonra sayfa1 de istenilen aktarma olmuyor.
 
Üstteki mesajımda ki kodu güncelledim. Tekrar deneyiniz.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst