• DİKKAT

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

Süzgeçten süzülen verilerin kopyasını 2.sayfaya kopyalama

Katılım
20 Şubat 2006
Mesajlar
259
Saygıdeğer Excel severler,
Çalışma sayfamdaki süzülen verilerden belirlediğim a5:a65536 b5:b65536 ve birkaç sütun dahil, kopyalayıp ikinci sayfanın b5:b65536 c5:c65536 d5:d65536 sütunlarına kopyalanmasını nasıl sağlayabilirim.

İlginiz ve yardımlarınız için şimdiden teşekkür ederim....
 
Sayın gecemavisi

Ekteki dosyada bununla ilgili önceden yapmış olduğum çalışmayı kendinize göre uyarlayabilirsiniz.
 
Sayın gecemavisi

Ekteki dosyada bununla ilgili önceden yapmış olduğum çalışmayı kendinize göre uyarlayabilirsiniz.

Not: Yanlışlıkla gönderildi.
 
Saygıdeğer Rustem Parlak;
İki tarih arasında elbette filitre yapılabilir. Otomatik süzgeç kısmından otomatik filitre butonuna basıpta özel kısmına girerseniz eğer, orda ilk kutuya 1. tarihi, ikinci kutuya ikinci tarihi yazdığınızda ve sağ tarafında eşittir veya büyüktür kriterlerini kullandığınızda işlem sizin istediğiniz gibi olur
 
örnek teki gibi yalnız listeye aktarmıyor
ilginiz içinde teşekkür ederim..
 
Saygıdeğer dostlar,
Peki ikinci sayfaya süzgeçten geçen verileri aktarırken b sütunundaki verileri baz alarak en son satırdan itibaren kopyalamaz mıyız?
İlginiz için teşekkürlerimi sunuyorum..
 
Saygıdeğer arkadaşlar;
1. sayfadan belli verileri 3. sayfaya kopyaladım. İkinci sayfadan verileri de 3. sayfaya kopyalamak istiyorum ama 3. sayfadaki d sütunu baz alınarak en son satırın peşinden yapıştırması gerek. Sizce bu iş nasıl olur.

Saygılarımla...
İlginiz ve yardımlarınız için teşekkür ederim..
 
Sn.gecemavisi
Kodlar sn. ripek'e ait olduğu için kendisi düzeltir diye düşündüm. Ama herhalde iki gündür siteye girmiyor.
Sorununuzu şöyle çözümlüyebilirsiniz.


Private Sub CommandButton1_Click()
On Error GoTo Süz_Hata
Dim a As Variant
Dim b As Variant
Dim c As Variant
Application.ScreenUpdating = False
Sheets("LİSTE").Select
'Range("B2:F1004").ClearContents
Sheets("DETAY").Select
a = ActiveSheet.Range("A65536").End(xlUp).Row
b = UserForm1.ComboBox1.Text
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=2, Criteria1:=b
Range("B2:F" & a).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("LİSTE").Select
Range("b65536").End(xlUp).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Yukardaki Sn. ripek'in dosyasındaki kodları kullanıyorsanız. ClearContents satırının önüne kesme işareti koyun. (devre dışı bırakın)
Liste sayfasındaki kırmızı yeri buradaki gibi değiştirin.
(Herhalde böyle olması lazım. Çünkü makro konusunda fazla bilgim yok.)
 
Saygıdeğer As3434,
Kodlar tahminim pek işimi görmüyor. Problemimi aiağıdaki kodlarla açıklamaya çalıştım. Saygılar..

Sub birlestir()
Sheets("DENEME1").Select
Cells.Select
Selection.EntireColumn.Hidden = False
Range("A1:Y124").Select
Selection.Copy
Sheets("DENEME3").Select
Cells.Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=102
Range("A125").Select
Sheets("DENEME2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("DENEME3").Select
ActiveSheet.Range("d65536").End(xlUp).Row
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End Sub

Saygıdeğer arkadaşlar sizce burda ne yanlışı var acaba

ActiveSheet.Range("d65536").End(xlUp).Row hata veriyor

Bu satırı nasıl yazmalıyım ki Deneme 2 deki veriler deneme 3 teki d satırının altındaki en son veriden 2 satır alta yapışsın...

Yardımınız ve ilginiz için teşekkürler.
 
Sn gecemavisi

ActiveSheet.Range("d65536").End(xlUp).select
 
........
..........
Selection.Copy

Sonrasını silerek yerine;

Sheets("DENEME3").Select
Range("A1").Select
b = WorksheetFunction.CountA(Sheets("("DENEME3").Range("D1:D65536"))
Sheets("("DENEME3").Cells(b + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

Kodlarını koyunuz.

Range("D1:D65536")) bunu istedğiniz sütun için değiştirebilirsiniz.
 
Saygıdeğer Arkadaşlar;
Sizce nerde yanlış yapıyorum ki, sayfa 2 deki veriler boş olarak kopyalanıyor;
Saygılarımla...


Windows("Deneme.xls").Activate
On Error Resume Next
Dim sayfa As Object
For Each sayfa In Sheets
sayfa.Unprotect Password:="1"
Next sayfa
Sheets("SAYFA1").Select
Range("A1:Y500").Select
Selection.Copy
Sheets("SAYFA3").Select
ActiveSheet.Paste
Sheets("SAYFA2").Select
Range("A2:Y40").Select
Selection.Copy
Sheets("SAYFA3").Select
b = WorksheetFunction.CountA(Sheets("SAYFA3").Range("D1:D65536"))
Sheets("SAYFA3").Cells(b + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Sn. gecemavisi
Kodları Birde şu şekilde denermisiniz

Sub deneme()
'Windows("Deneme.xls").Activate
'On Error Resume Next
'Dim sayfa As Object
'For Each sayfa In Sheets
'sayfa.Unprotect Password:="1"
'Next sayfa

Application.ScreenUpdating = False

Sheets("sayfa3").Select
Range("a1:y65000").ClearContents 'a1 den y65000 alan temizle
Sheets("SAYFA1").Range("A1:Y500").Copy
Sheets("SAYFA3").Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("SAYFA2").Range("A2:Y40").Copy
Sheets("SAYFA3").Range("a65536").End(xlUp).Select
If ActiveCell.Address = "$a$1" Then
ActiveCell.Select
Else
ActiveCell.Offset(1, 0).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("SAYFA3").Select
Range("a1").Select
Application.ScreenUpdating = True
End Sub
 
Sn. gecemavisi
2 satır alta demişsiniz görmedim.
ActiveCell.Offset(1,0).select
Satırını
ActiveCell.Offset(3,0).select
Olarak değiştirin.
 
Geri
Üst