Bir sayfadaki bilgileri diğer sayfalara dağıtma

[Orion1]

Yok hayır silinmeyecek genel sayfasında kalacak.

Bu durumda aktarılacağı sayfada ayni adla yüklenmişse o aktarılmayacak,öylemi?

 

[sinekvalesi]

Bu durumda aktarılacağı sayfada ayni adla yüklenmişse o aktarılmayacak,öylemi?

Diyelim ki genel sayfasında 5 satır hareket var. Bu 5 satır daha önce ilgili sayfalara aktarılmış. Daha sonra genel sayfasına 6.satır yazıldı ve ilgili sayfaya aktamak için sizin oluşturduğunuz " Tıkla " ya bastık. Böylece daha önce aktardığımız 5 satır ve 6. satır tekrar ilgili sayfalara aktarılmış oluyor. Yani daha önce aktarılmış bilgiler, tekrar 6.satırı aktarmak istediğimizde yeniden aktarılmış oluyor.

 

[Orion1]

Diyelim ki genel sayfasında 5 satır hareket var. Bu 5 satır daha önce ilgili sayfalara aktarılmış. Daha sonra genel sayfasına 6.satır yazıldı ve ilgili sayfaya aktamak için sizin oluşturduğunuz " Tıkla " ya bastık. Böylece daha önce aktardığımız 5 satır ve 6. satır tekrar ilgili sayfalara aktarılmış oluyor. Yani daha önce aktarılmış bilgiler, tekrar 6.satırı aktarmak istediğimizde yeniden aktarılmış oluyor.

Genel sayfasında hangi sütunu kontrol edecez tekrar aktarılmamsı için?

 

[sinekvalesi]

Genel sayfasında hangi sütunu kontrol edecez tekrar aktarılmamsı için?

Market sütununun sol tarafına "sıra no" diye bir sütun açıp sıra numarasını kontrol edebiliriz.

Teşekkürler

 

[Orion1]

Dosyanız ektedir.

Sub sayfayaat_59()
Dim i As Long, sat As Long, sh As Worksheet
Dim sh2 As Worksheet, sat2 As Long
Set sh = Sheets("genel")
Application.ScreenUpdating = False
sh.Range("A1").AutoFilter
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To Worksheets.Count
    Set sh2 = Sheets(i)
    sh.Range("A1").AutoFilter field:=1, Criteria1:=sh2.Name
    sh.Range("A1").AutoFilter field:=7, Criteria1:="<>Evet"
    If WorksheetFunction.Subtotal(103, sh.Range("A2:A" & sh.Rows.Count)) > 0 Then
        sat = sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A1").CurrentRegion.Offset(1, 0).Copy sh2.Range("A" & sat)
        sh.Range("G2:G" & sat2).SpecialCells(xlCellTypeVisible).Value = "Evet"
        sh.Range("A1").AutoFilter
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[sinekvalesi]

Dosyanız ektedir.

Sub sayfayaat_59()
Dim i As Long, sat As Long, sh As Worksheet
Dim sh2 As Worksheet, sat2 As Long
Set sh = Sheets("genel")
Application.ScreenUpdating = False
sh.Range("A1").AutoFilter
sat2 = sh.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To Worksheets.Count
    Set sh2 = Sheets(i)
    sh.Range("A1").AutoFilter field:=1, Criteria1:=sh2.Name
    sh.Range("A1").AutoFilter field:=7, Criteria1:="<>Evet"
    If WorksheetFunction.Subtotal(103, sh.Range("A2:A" & sh.Rows.Count)) > 0 Then
        sat = sh2.Cells(Rows.Count, "A").End(xlUp).Row + 1
        sh.Range("A1").CurrentRegion.Offset(1, 0).Copy sh2.Range("A" & sat)
        sh.Range("G2:G" & sat2).SpecialCells(xlCellTypeVisible).Value = "Evet"
        sh.Range("A1").AutoFilter
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

Sayın Orion1;

Yardımlarınız için çok çok teşekkür ederim. Gerçekten mükemmel oldu.

Saygılar.