sayfalara gönder kodu hakkında

Endless033

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
07-09-2025
arkadaşlar bir excell kitabında 2 sayfam var veri girişinde sayfaya gönder kodu uyguladım yalnız nevi 1 hücresini dikkate alıyor aynı andan solunda kasa hücresi var aynı butona tıklayınca hem nevi 1 dikkate alacak hemde kasa sutunu dikkate alarak ilgili sayfasına gönderecek
inşallah antabilmişimdir.

kod:
Sub sayfalara_gönder()
Application.ScreenUpdating = False
On Error Resume Next
Set S1 = ThisWorkbook.Worksheets("veri")
For i = 11 To S1.Range("h65536").End(xlUp).Row
If S1.Cells(i, "p") = "" Then
Set S2 = ThisWorkbook.Worksheets(S1.Cells(i, "h").Value)
sonsatir = S2.Range("A65536").End(xlUp).Row + 1
S2.Cells(sonsatir, 1) = S1.Cells(i, 1)
S2.Cells(sonsatir, 2) = S1.Cells(i, 2)
S2.Cells(sonsatir, 3) = S1.Cells(i, 3)
S2.Cells(sonsatir, 4) = S1.Cells(i, 4)
S2.Cells(sonsatir, 5) = S1.Cells(i, 5)
S2.Cells(sonsatir, 6) = S1.Cells(i, 6)
S2.Cells(sonsatir, 7) = S1.Cells(i, 7)
S2.Cells(sonsatir, 8) = S1.Cells(i, 8)
S2.Cells(sonsatir, 9) = S1.Cells(i, 9)
S2.Cells(sonsatir, 10) = S1.Cells(i, 10)
S2.Cells(sonsatir, 11) = S1.Cells(i, 11)
S2.Cells(sonsatir, 12) = S1.Cells(i, 12)
S2.Cells(sonsatir, 13) = S1.Cells(i, 13)
S2.Cells(sonsatir, 14) = S1.Cells(i, 14)
S2.Cells(sonsatir, 15) = S1.Cells(i, 15)
S2.Cells(sonsatir, 16) = S1.Cells(i, 16)

S1.Cells(i, "p") = "kayıt"
kayıt = kayıt + 1
End If
Next i
Application.ScreenUpdating = True
If kayıt >= 1 Then MsgBox kayıt & " Adet veri sayfalara gönderildi Mustafa avcı.", vbInformation
If kayıt = 0 Then MsgBox " Kayıt edilecek veri bulunamadı.", vbCritical

End Sub
 

Ekli dosyalar

H

Hepgel

Katılım
18 Ocak 2019
Mesajlar
234
Excel Vers. ve Dili
Office 2013
Merhaba @Endless033

Dosyanızı dış serverler'den birine yükleyip link paylaşabilir misiniz.
Olması gerekeni örneklendirerek.
 
Endless033

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
07-09-2025
Hepgel' Alıntı:
Merhaba @Endless033

Dosyanızı dış serverler'den birine yükleyip link paylaşabilir misiniz.
Olması gerekeni örneklendirerek.
Genişletmek için tıkla ...
şuan veri sayfasında kayıt durumu hücresi altındaki kayıt yazanları silin sadece sayfaya gönder yapınca nevi 1 tukcelll olanları sayfasına gönderiyor sıkıntı yok gayet çalışıyor ben hemen aynı anda kasa hücresi altında kasa yazıyorsa onuda kasaya atmasını istiyorum
 
H

Hepgel

Katılım
18 Ocak 2019
Mesajlar
234
Excel Vers. ve Dili
Office 2013
Aşağıdaki ilk satırla son satırın arasındakiler mevcut koda eklenirse sorununuz giderilir.
Mevcut kodda ilk satırla son satır alt alta durumda

C++: 
Set S1 = ThisWorkbook.Worksheets("veri")
Set S3 = ThisWorkbook.Worksheets("KASA")
If S1.AutoFilterMode Then S1.AutoFilterMode = False
S1son = S1.Cells(Rows.Count, 2).End(3).Row
    S1.Range("A10:P" & S1son).AutoFilter Field:=7, Criteria1:="KASA"
    If S1.Cells(Rows.Count, 2).End(3).Row > 10 Then
        S1.Range("A11:P" & S1son).SpecialCells(xlCellTypeVisible).Copy _
            S3.Cells(S3.Cells(Rows.Count, 2).End(3).Row + 1, 1)
    End If
    S1.Range("A10:P" & S1son).AutoFilter Field:=7
For i = 11 To S1.Range("h65536").End(xlUp).Row
 
Endless033

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
07-09-2025
Hepgel' Alıntı:
Aşağıdaki ilk satırla son satırın arasındakiler mevcut koda eklenirse sorununuz giderilir.
Mevcut kodda ilk satırla son satır alt alta durumda

C++: 
Set S1 = ThisWorkbook.Worksheets("veri")
Set S3 = ThisWorkbook.Worksheets("KASA")
If S1.AutoFilterMode Then S1.AutoFilterMode = False
S1son = S1.Cells(Rows.Count, 2).End(3).Row
    S1.Range("A10:P" & S1son).AutoFilter Field:=7, Criteria1:="KASA"
    If S1.Cells(Rows.Count, 2).End(3).Row > 10 Then
        S1.Range("A11:P" & S1son).SpecialCells(xlCellTypeVisible).Copy _
            S3.Cells(S3.Cells(Rows.Count, 2).End(3).Row + 1, 1)
    End If
    S1.Range("A10:P" & S1son).AutoFilter Field:=7
For i = 11 To S1.Range("h65536").End(xlUp).Row
Genişletmek için tıkla ...
valla anlamadım dosyayı sizde filebig yükleme şansınız varmı ordan incelerim ben zaten yapmış oldugunuz değişikliği
 
Endless033

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
07-09-2025
Hepgel' Alıntı:
Aşağıdaki ilk satırla son satırın arasındakiler mevcut koda eklenirse sorununuz giderilir.
Mevcut kodda ilk satırla son satır alt alta durumda

C++: 
Set S1 = ThisWorkbook.Worksheets("veri")
Set S3 = ThisWorkbook.Worksheets("KASA")
If S1.AutoFilterMode Then S1.AutoFilterMode = False
S1son = S1.Cells(Rows.Count, 2).End(3).Row
    S1.Range("A10:P" & S1son).AutoFilter Field:=7, Criteria1:="KASA"
    If S1.Cells(Rows.Count, 2).End(3).Row > 10 Then
        S1.Range("A11:P" & S1son).SpecialCells(xlCellTypeVisible).Copy _
            S3.Cells(S3.Cells(Rows.Count, 2).End(3).Row + 1, 1)
    End If
    S1.Range("A10:P" & S1son).AutoFilter Field:=7
For i = 11 To S1.Range("h65536").End(xlUp).Row
Genişletmek için tıkla ...
tamamdır yaptım şimdi anladım emeğinize sağlık tşk ettim
 
Endless033

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
07-09-2025
yalnız bir sıkıntı var sayfalara gönderdi ama tekrardan gönder dediğimde kayıt durumu hücresinde kayıt yazıldığı halde turkcele gönderme yapmıyor ama kasaya devamlı önceki veriyi gönderiyor
 
H

Hepgel

Katılım
18 Ocak 2019
Mesajlar
234
Excel Vers. ve Dili
Office 2013
Endless033' Alıntı:
yalnız bir sıkıntı var sayfalara gönderdi ama tekrardan gönder dediğimde kayıt durumu hücresinde kayıt yazıldığı halde turkcele gönderme yapmıyor ama kasaya devamlı önceki veriyi gönderiyor
Genişletmek için tıkla ...
Aynı şekilde Set S1... ile For i =... arasını şöyle yapar mısınız.

C++: 
Set S1 = ThisWorkbook.Worksheets("veri")
Set S3 = ThisWorkbook.Worksheets("KASA")
If S1.AutoFilterMode Then S1.AutoFilterMode = False
S1son = S1.Cells(Rows.Count, 2).End(3).Row
    S1.Range("A10:P" & S1son).AutoFilter Field:=7, Criteria1:="KASA"
    S1.Range("A10:P" & S1son).AutoFilter Field:=16, Criteria1:=""
    If S1.Cells(Rows.Count, 2).End(3).Row > 10 Then
        S1.Range("A11:P" & S1son).SpecialCells(xlCellTypeVisible).Copy _
            S3.Cells(S3.Cells(Rows.Count, 2).End(3).Row + 1, 1)
    End If
    S1.Range("A10:P" & S1son).AutoFilter Field:=7
    S1.Range("A10:P" & S1son).AutoFilter Field:=16
For i = 11 To S1.Range("h65536").End(xlUp).Row
 
Endless033

Endless033

Altın Üye
Katılım
25 Haziran 2013
Mesajlar
140
Excel Vers. ve Dili
türkçe
Altın Üyelik Bitiş Tarihi
07-09-2025
Hepgel' Alıntı:
Aynı şekilde Set S1... ile For i =... arasını şöyle yapar mısınız.

C++: 
Set S1 = ThisWorkbook.Worksheets("veri")
Set S3 = ThisWorkbook.Worksheets("KASA")
If S1.AutoFilterMode Then S1.AutoFilterMode = False
S1son = S1.Cells(Rows.Count, 2).End(3).Row
    S1.Range("A10:P" & S1son).AutoFilter Field:=7, Criteria1:="KASA"
    S1.Range("A10:P" & S1son).AutoFilter Field:=16, Criteria1:=""
    If S1.Cells(Rows.Count, 2).End(3).Row > 10 Then
        S1.Range("A11:P" & S1son).SpecialCells(xlCellTypeVisible).Copy _
            S3.Cells(S3.Cells(Rows.Count, 2).End(3).Row + 1, 1)
    End If
    S1.Range("A10:P" & S1son).AutoFilter Field:=7
    S1.Range("A10:P" & S1son).AutoFilter Field:=16
For i = 11 To S1.Range("h65536").End(xlUp).Row
Genişletmek için tıkla ...
tşk ederim konu çözülmüştür,emeğinize bilginize sağlık
 
H

Hepgel

Katılım
18 Ocak 2019
Mesajlar
234
Excel Vers. ve Dili
Office 2013
Rica Ederim.
Kolay Gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst