bilgileri diğer sayfaya gönderme

[ozcanya]

arkadaşlar dosyam ekte rıca etsem yardımcı olurmusunuz

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Arşive aktarmak istediğiniz satırda herhangi bir hücreyi seçip butona tıklayınız.

 

[ozcanya]

Üstat teşekkür ederim
Aktar diyorum ama bilgiler aktarıldı dediği halde aktarım yok
bakmanızı rıc etsem?

 

[Ferhat Pazarçevirdi]

Sn.Özcanya,

Kodlar bende problemsiz çalışıyor.

SAdece Sn.COST_CONTROL, boş satırlar için uyarı mesajı koymamış. Çok da büyük bir eksiklik değil. "Dolu satırları" seçip aktar derseniz aktarıyor. Hatta aynı kayıt arşivde varsa'da uyarı mesajı veriyor.

Boş satırlarda farklı bir mesaj vermesi için COST_CONTROL'un kodlarına bir blok ilave ettim. Bunu deneyiniz.

Sub ARŞİVE_AKTAR()
    If ActiveCell.Row < 7 Then
    MsgBox "BU SATIRI AKTARAMAZSINIZ !" & vbCrLf & "LÜTFEN FARKLI BİR SATIR SEÇİNİZ.", vbCritical, "UYARI !"
    Exit Sub: End If
[COLOR=teal][COLOR=green]'-------- BOŞ SATIR KONTROLÜ --------------[/COLOR]
[/COLOR]    For i = 2 To 11
        deger = deger & Cells(ActiveCell.Row, i)
    Next i
    If Len(deger) = 0 Then: MsgBox "BOŞ SATIR AKTARILMAZ.BAŞKA BİR KAYIT SEÇİN", vbCritical, "UYARI": Exit Sub
[COLOR=green]'------------------------------------------[/COLOR]
    SON_SATIR = Sheets("arşiv").[B65536].End(3).Row + 1
    SATIR = ActiveCell.Row
    If WorksheetFunction.CountIf(Sheets("arşiv").[F:F], Cells(SATIR, "F")) > 0 Then GoTo SON
    Sheets("arşiv").Range("B" & SON_SATIR & ":K" & SON_SATIR) = Range("B" & SATIR & ":K" & SATIR).Value
    MsgBox "SEÇTİĞİNİZ KAYIT ARŞİVE AKTARILMIŞTIR.", vbInformation
    Exit Sub
SON: MsgBox "BU KAYIT DAHA ÖNCE AKTARILMIŞTIR !" & vbCrLf & "LÜTFEN BAŞKA BİR KAYIT SEÇİNİZ.", vbCritical, "UYARI !"
End Sub

 

[ozcanya]

Özür dilerim tek tek göndermek gerek sanırım
her her kayıtda gönder demek gerekir her halde

 

[ozcanya]

Dostum teşekkür ederim her zaman ki gibi,
yardım aldım sizden
Bu şekilde iyi .teşekkür ederim.
sizden başka konuda yardım isteyebir miyim
dosyayı ekliyorum
bu dosyayı bana siz yaptınız ben de ekler yaptım. yapamadığım dosyanın içerisin de aşı kartı adında bir sayfa var Ben bu sayfaya diğer sayfalardan veri alıp cıktısını almak istiyorum.Açıklamam sayfada
teşekkür ederim.

 

[Ferhat Pazarçevirdi]

Ekteki dosyayı inceleyiniz.

 

[ozcanya]

Teşekkkürler.

Mukemmel olmuş Ana adlı sayfayı ekleme zannederim unuttunuz
rıca etsem
selamlar kolay gelsin
(Çocuğa ait diğer Bilgileri Üser forumda Görmek mümkün mü)

 

[ozcanya]

fpc Konu Hakkında bana yardımcı olmanızı rıca etsem?
kusura bakmayın

 

[Ferhat Pazarçevirdi]

Userform2'nin initialize kodunu aşağıdaki gibi değiştirin.

(Çocuğa ait diğer Bilgileri Üser forumda Görmek mümkün m&#252

Neleri görmek isterseniz onları gösteririz

Private Sub UserForm_Initialize()
Dim arrSayfa() As Variant
Dim i%, j%
arrSayfa = Array("aktarma sayfası", "Aşı Kartı", "Doz")
For i = 1 To Sheets.Count
    For j = 0 To 2
        If Sheets(i).Name = arrSayfa(j) Then: GoTo f1
    Next j
    ComboBox1.AddItem Sheets(i).Name
f1:
Next i
ComboBox1.ListIndex = 0
With ListView1
    .ColumnHeaders.Add , , "Adı", 78
    .ColumnHeaders.Add , , "Soyadı", 100
    .ColumnHeaders.Add , , "Baba Adı", 70
    .View = lvwReport
    .Gridlines = True
    .FullRowSelect = True
End With
CommandButton2.Cancel = True
Me.Caption = "AŞI KARTI OLUŞTUR"
End Sub

 

[ozcanya]

Oldu teşekkür ederim
soy adından kkk olan kısım