• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Seçilen Sayfaya Göre Kayıt Yapmak

  • Konbuyu başlatan Konbuyu başlatan wishm
  • Başlangıç tarihi Başlangıç tarihi
W

wishm

Katılım
10 Haziran 2009
Mesajlar
166
Excel Vers. ve Dili
2003
Değerli site üyeleri ekte göndermiş olduğum dosya ile bir sayfadan diğer sayfaya kayıt yapabiliyorum. Ancak benim istediğim sabit bir sayfaya değil seçeceğim sayfalara kayıt yapabilmek. Konu ile ilgili yardımlarınız için şimdiden teşekkür ederim. Saygılarımla.
 

Ekli dosyalar

Kod: 
Private Sub CommandButton1_Click()
Dim sh2 As Worksheet, sat As Long
Dim sat1 As Long, sat2 As Long, i As Long, sut As Byte
[COLOR="Red"]Dim sayfa As String[/COLOR]
[COLOR="Red"]sayfa = Sheets("data").Range("d18").Value[/COLOR]
[COLOR="Red"]Sheets(sayfa).Select[/COLOR]
Application.ScreenUpdating = False
[COLOR="Red"]Set sh2 = Sheets(sayfa)[/COLOR]
sat = Cells(65535, "B").End(xlUp).Row
sat1 = sh2.Cells(65535, "B").End(xlUp).Row + 1
If sat1 + 2 >= 65535 Then
    MsgBox "VERÝ TABANI DOLDUÐU ÝÇÝN KAYIT ÝÞLEMÝ YAPILAMADI ÝÞLEM ÝPTAL EDÝLDÝ.", vbCritical, "UYARI"
    Exit Sub
End If
sut = 1
For i = 4 To sat Step 2
    sh2.Cells(sat1, sut).Value = Cells(i, "D").Value
    sut = sut + 1
    sat2 = sat2 + 1
Next
Sheets("data").Range("D6,D8,D10,D12,D14,D16,D18,D20,D22,D24,D26,D28,D30").ClearContents
Application.ScreenUpdating = True
MsgBox "KAYIT ÝÞLEMÝ BAÞARI ÝLE GERÇEKLEÞTÝRÝLDÝ." & vbLf & "", vbOKOnly + vbInformation, "BÝLGÝ"
End Sub

kodunuzu bu sekilde editleyebirisiniz.. Ayrica sayfa 3 teki ad tanimlarinizdaki ad tanimlarinizi sayfa isimleriyle ayni yapiniz, Alis, Satis seklinde..
 
evet bende farkettim simdi ama anlayamadim bir kez daha calistirinca hata vermeden calisiyor oyle degil mi ?

yani demek oluyor ki on error resume next eklesek koda iyi olur :)

Kod: 
Private Sub CommandButton1_Click()
On Error Resume Next
Dim sh2 As Worksheet, sat As Long
Dim sat1 As Long, sat2 As Long, i As Long, sut As Byte
Dim sayfa As String
sayfa = Sheets("data").Range("d18").Value

Sheets(sayfa).Select
Application.ScreenUpdating = False
Set sh2 = Sheets(sayfa)
sat = Cells(65535, "B").End(xlUp).Row
sat1 = sh2.Cells(65535, "B").End(xlUp).Row + 1
If sat1 + 2 >= 65535 Then
    MsgBox "VERÝ TABANI DOLDUÐU ÝÇÝN KAYIT ÝÞLEMÝ YAPILAMADI ÝÞLEM ÝPTAL EDÝLDÝ.", vbCritical, "UYARI"
    Exit Sub
End If
sut = 1
For i = 4 To sat Step 2
    sh2.Cells(sat1, sut).Value = Cells(i, "D").Value
    sut = sut + 1
    sat2 = sat2 + 1
Next
Sheets("data").Range("D6,D8,D10,D12,D14,D16,D18,D20,D22,D24,D26,D28,D30").ClearContents
Application.ScreenUpdating = True
MsgBox "KAYIT ÝÞLEMÝ BAÞARI ÝLE GERÇEKLEÞTÝRÝLDÝ." & vbLf & "", vbOKOnly + vbInformation, "BÝLGÝ"
End Sub
 
Sayın Mustafaine vermiş olduğunuz kodu denedim. Bahsettiğiniz gibi hata vermedi ancak kayıt işlemini gerçekleştirmiyor.
 
wishm' Alıntı:
Değerli site üyeleri ekte göndermiş olduğum dosya ile bir sayfadan diğer sayfaya kayıt yapabiliyorum. Ancak benim istediğim sabit bir sayfaya değil seçeceğim sayfalara kayıt yapabilmek. Konu ile ilgili yardımlarınız için şimdiden teşekkür ederim. Saygılarımla.
Genişletmek için tıkla ...
Buyrun Dosyanız Ekte...:cool:
 

Ekli dosyalar

Sayın security yanıtınız için teşekkür ederim. Ancak kodlar istediğim gibi çalışmıyor. Her iki durumda da kayıt aynı sayfaya yapılıyor.
 
SN: mustafaine Sorununuzu Çözmüş Tşk...
 
Sayın Mustafaine ve sayın security yanıtlarınız ve ilginiz için teşekkür ederim. Son olarak
Sheets(sayfa).Select
Genişletmek için tıkla ...
kodu çıkarınca istediğim gibi oldu. Tekrar teşekkür ederim. Saygılarımla.
 
Set sh2 = Sheets(sayfa)
Diyerek o atamayi yine yapiyorsunuz o olsada olmasada calismasi gerekir ben zaten kodlarinizi hic degistirmedim, kolay gelsin..
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst