Süz aktar

[CILEKESH]

Herkese Merhaba,

Cari Sekmesindeki "(I1)" hücresindeki değişkene göre Data sekmesindeki "A" sütununu süzerek

Data sekmesindeki (B2:E1000) aralığını cari sekmesindeki (A2: D1000) aralığına yapıştırsın istiyorum. İşlemden sonra süzme iptal edilsin.

Teşekkür Ederim.

 

[Orion1]

Dosyanız ektedir.

Sub suz_aktar_59()
Dim sat As Long, sh As Worksheet
Sheets("data").Select
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sh = Sheets("cari")
sat = Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A2:D" & sh.Rows.Count).ClearContents
Range("A1").AutoFilter
Range("A1").AutoFilter field:=1, Criteria1:=sh.Range("I1").Value
If WorksheetFunction.Subtotal(103, Range("A1:A" & sat)) > 1 Then
    Range("A1").CurrentRegion.Copy sh.Range("A1")
End If
Range("A1").AutoFilter
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
sh.Select
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

 

[CILEKESH]

Dosyanız ektedir.

Sub suz_aktar_59()
Dim sat As Long, sh As Worksheet
Sheets("data").Select
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set sh = Sheets("cari")
sat = Cells(Rows.Count, "A").End(xlUp).Row
sh.Range("A2:D" & sh.Rows.Count).ClearContents
Range("A1").AutoFilter
Range("A1").AutoFilter field:=1, Criteria1:=sh.Range("H1").Value
If WorksheetFunction.Subtotal(103, Range("A1:A" & sat)) > 1 Then
    Range("A1").CurrentRegion.Offset(1, 1).Copy sh.Range("A2")
End If
Range("A1").AutoFilter
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
sh.Select
MsgBox "Veriler aktarıldı." & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation
End Sub

Sayın Orion1 çok teşekkür ederim, (Küçük bir sorun var)

Cari sekmesinde "E" sütununda bulunan formüller bu kodda bozuluyor Bozulmaması için kod nasıl düzeltilir?.

 

[Orion1]

Dosyayı düzenledim.2 numaralı mesajdan indirebilirsiniz.

 

[CILEKESH]

Dosyayı düzenledim.2 numaralı mesajdan indirebilirsiniz.

Elinize sağlık hocam,
Bilgi amaçlı soruyorum;
5 sütunu süzdü isek 5 sütunda aktarmamız mı gerekiyor!
Ya da süzülen sütunun muhakkak aktarılması mı gerekiyor!

 

[Orion1]

Elinize sağlık hocam,
Bilgi amaçlı soruyorum;
5 sütunu süzdü isek 5 sütunda aktarmamız mı gerekiyor!
Ya da süzülen sütunun muhakkak aktarılması mı gerekiyor!

offset kulanarak azaltabiliriz ama burada formüller silindi.
iyi gclr.