Aktar ve Sİl

[polis-53]

merhaba arkadaşlar aşağıdaki kod aktarıyor benim istediğim aktarılanın sayfadan da silinmesi

Sub AKTAR()
'
' Düğme1_Tıklat Makro
'

'
Dim sh As Worksheet
Application.ScreenUpdating = False

Set sh = Sheets("liste")
Sheets("Form").Select
Range("A:E").ClearContents
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=5, Criteria1:=Sheets("Liste").Range("F1")
sh.Range("A1").CurrentRegion.Copy Range("A1")
sh.Range("A1").AutoFilter
Columns("e:f").Select
Selection.Delete Shift:=xlToLeft
Range("f1").Select

Sheets("Liste").Select
Application.ScreenUpdating = True
Range("f1").Select
MsgBox "Ana listeden ölçüye uyan öğrenciler  aktarılmıştır."


End Sub

 

[BaY_KaPTaN]

Merhaba.
Örnek dosya yok ama aşağıdaki kodu sona ekleyebilirseniz aktarır sanırım.

    For x = [A65536].End(3).Row To 1 Step -1
    If Cells(x, "A") = Sheets("Liste").Range("F1") Then Rows(x).Delete Shift:=xlUp
    Next

 

[polis-53]

For x = [A65536].End(3).Row To 1 Step -1 If Cells(x, "A") = Sheets("Liste").Range("F1") Then Rows(x).Delete Shift:=xlUp Next

selamun alyekum aktarım gerçekleşivor fakat aktarılan satırları silmiyor.

 

[muratboz06]

Deneyiniz.
Sayfa ismi liste mi Liste mi?

Sub AKTAR()
'
' Düğme1_Tıklat Makro
'

'
Dim sh As Worksheet
Application.ScreenUpdating = False

Set sh = Sheets("liste")
Sheets("Form").Select
Range("A:E").ClearContents
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=5, Criteria1:=Sheets("Liste").Range("F1")
sh.Range("A1").CurrentRegion.Copy Range("A1")
sh.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
sh.AutoFilterMode = False
Columns("e:f").Select
Selection.Delete Shift:=xlToLeft
Range("f1").Select

Sheets("Liste").Select
Application.ScreenUpdating = True
Range("f1").Select
MsgBox "Ana listeden ölçüye uyan öğrenciler  aktarılmıştır."


End Sub

 

[polis-53]

merhaba aşağıdaki

Deneyiniz.
Sayfa ismi liste mi Liste mi?

Sub AKTAR()
'
' Düğme1_Tıklat Makro
'

'
Dim sh As Worksheet
Application.ScreenUpdating = False

Set sh = Sheets("liste")
Sheets("Form").Select
Range("A:E").ClearContents
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=5, Criteria1:=Sheets("Liste").Range("F1")
sh.Range("A1").CurrentRegion.Copy Range("A1")
sh.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
sh.AutoFilterMode = False
Columns("e:f").Select
Selection.Delete Shift:=xlToLeft
Range("f1").Select

Sheets("Liste").Select
Application.ScreenUpdating = True
Range("f1").Select
MsgBox "Ana listeden ölçüye uyan öğrenciler  aktarılmıştır."


End Sub

bu kodda hata verdi
sh.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
Sayfa ismide Liste

 

[polis-53]

Sub AKTAR() ' ' Düğme1_Tıklat Makro ' ' Dim sh As Worksheet Application.ScreenUpdating = False Set sh = Sheets("liste") Sheets("Form").Select Range("A:E").ClearContents sh.Range("A1").AutoFilter sh.Range("A1").AutoFilter field:=5, Criteria1:=Sheets("Liste").Range("F1") sh.Range("A1").CurrentRegion.Copy Range("A1") sh.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete sh.AutoFilterMode = False Columns("e:f").Select Selection.Delete Shift:=xlToLeft Range("f1").Select Sheets("Liste").Select Application.ScreenUpdating = True Range("f1").Select MsgBox "Ana listeden ölçüye uyan öğrenciler aktarılmıştır." End Sub

Method or data member not found "Yöntem veya veri üyesi bulunamadı"

 

[muratboz06]

Set sh = Sheets("liste") satırını
Set sh = Sheets("Liste") olarak değiştiriniz.
Örnek excel dosyası paylaşabilir misiniz?

 

[polis-53]

Set sh = Sheets("liste") satırını
Set sh = Sheets("Liste") olarak değiştiriniz.
Örnek excel dosyası paylaşabilir misiniz?

Hocam yine olmadı dosya lingi ektedir.

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

 

[BaY_KaPTaN]

Hocam yine olmadı dosya lingi ektedir.

Lifebox Transfer: Upload File! Send and Share Large Files

Lifeboxtransfer is a fast file transfer service for sharing your files easily without membership. Click and start sharing your files fast and easily with lifeboxtransfer.

lifeboxtransfer.com

Dosyanız ektedir.

veri_aktar_secime_gore.xlsm dosyasını indir - download

veri_aktar_secime_gore.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[polis-53]

Dosyanız ektedir.

veri_aktar_secime_gore.xlsm dosyasını indir - download

veri_aktar_secime_gore.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

günaydın verdiğiniz linkten dosyayı indiremiyorum benim işyerim bunu engelliyor. kodlarını atarsanız iyi olur.

 

[BaY_KaPTaN]

günaydın verdiğiniz linkten dosyayı indiremiyorum benim işyerim bunu engelliyor. kodlarını atarsanız iyi olur.

Günaydın.
A Satırını silin aşağıdaki gibi olsun.


Sonra kodları aşağıdaki şekilde ayarlayabilirsiniz.

Sub AKTAR()
'
' Düğme1_Tıklat Makro
'

'
Dim sh As Worksheet
Application.ScreenUpdating = False

Set sh = Sheets("Liste")
Sheets("Form").Select
Range("A:E").ClearContents
sh.Range("A1").AutoFilter
sh.Range("A1").AutoFilter field:=5, Criteria1:=Sheets("Liste").Range("F1")
sh.Range("A1").CurrentRegion.Copy Range("A1")

sh.AutoFilterMode = False
Columns("e:f").Select
Selection.Delete Shift:=xlToLeft
Range("f1").Select

Sheets("Liste").Select
Application.ScreenUpdating = True
Range("f1").Select

    For x = [A65536].End(3).Row To 1 Step -1
    If Cells(x, "E") = Sheets("Liste").Range("F1") Then Rows(x).Delete Shift:=xlUp
    Next
MsgBox "Ana listeden ölçüye uyan öğrenciler  aktarılıp, silinmiştir."
End Sub