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

[gecemavisi]

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....

 

[Recep İpek]

Sayın gecemavisi

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

 

[Recep İpek]

Sayın gecemavisi

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

Not: Yanlışlıkla gönderildi.

 

[gecemavisi]

Sn Ripek,
İlginize ve yardımınıza teşekkür ederim.

 

[rustemparlak]

cok güzel olmuş ama

iki tarih arasıda filitre yapılabilirmi

 

[gecemavisi]

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

 

[Recep İpek]

Bunun gibi mi?

 

[gecemavisi]

Örneği inceleyebilirsiniz.

 

[rustemparlak]

örnek teki gibi yalnız listeye aktarmıyor
ilginiz içinde teşekkür ederim..

 

[gecemavisi]

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..

 

[gecemavisi]

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..

 

[AS3434]

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.)

 

[gecemavisi]

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.

 

[AS3434]

Sn gecemavisi

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

 

[AS3434]

d satırının altındaki en son veriden s2 satır alta yapışsın...

Yalnız burayı anlamadım.

 

[Merhum İdris SERDAR]

........
..........
Selection.Copy

Sonrasını silerek yerine;

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

Kodlarını koyunuz.

Range("D165536")) bunu istedğiniz sütun için değiştirebilirsiniz.

 

[gecemavisi]

Saygıdeğer Yurttaş;
Cevabınıza çok sevindim. Çok işimi gördü.
İyi çalışmalar...

 

[gecemavisi]

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("D165536"))
Sheets("SAYFA3").Cells(b + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

 

[AS3434]

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

 

[AS3434]

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.