• DİKKAT

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

Kaydet makroları çalıştırılamıyor.

I

istanbulcahan

Katılım
11 Ocak 2008
Mesajlar
1,395
Excel Vers. ve Dili
Office 365 (Türkçe)
Her kaydet makrosuna 1 den başlayarak numaralar verdim ve kaydettim. Ancak makroları çalıştıramadım.Yardımcı olurmusunuz.
Kod: 
Sub sayfaya_kaydett1()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett2()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett3()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett4()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett5()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett6()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett7()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett8()
Set s1 = ThisWorkbook.Worksheets("giriş")
For zz = 1 To 1
If s1.Cells(2, 3) = "" Then Exit For
Set s2 = ThisWorkbook.Worksheets("data")

sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
s2.Cells(sonsatir, 2) = s1.Cells(2, 3)
s2.Cells(sonsatir, 3) = s1.Cells(3, 3)
s2.Cells(sonsatir, 4) = s1.Cells(4, 3)
s2.Cells(sonsatir, 5) = s1.Cells(5, 3)
s2.Cells(sonsatir, 6) = s1.Cells(6, 3)
s2.Cells(sonsatir, 7) = s1.Cells(7, 3)
s2.Cells(sonsatir, 8) = s1.Cells(8, 3)
s2.Cells(sonsatir, 9) = s1.Cells(9, 3)

Set s2 = Nothing
Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
 

Ekli dosyalar

Makroların hepsi aynı değilmi? Neyi çalıştıramadınız?
 
Evet aynı özelliktedir. Ama burada Sub sayfaya_kaydett2() rakamlar değişince farklı olması lazım değilmi. Tabii makrodan anlamadığım gibi mantığını bilmiyorum. Sadece bir excel çalışmasındaki kaydet makrosunu birden fazla çoğalttım.
 
Evet en sonunda bu işi öğrenmeye karar verdiğinizi anlıyorum.

Kodlarınızdaki bu bölümde
Kod: 
Set s2 = ThisWorkbook.Worksheets("[COLOR=red]data[/COLOR]")
data sayfası olmadığından kayıt yapamıyorsunuz.
 
data1 sayfası için birazcık kısaltılmış kod:

Kod: 
Sub sayfaya_kaydett1()
Set s1 = ThisWorkbook.Worksheets("[COLOR=red]giriş[/COLOR]")
Set s2 = ThisWorkbook.Worksheets("[COLOR=red]data1[/COLOR]")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
 
Üstadım aşağıdaki şekilde dediğiniz şekilde değiştirdim. Aynı çalıştırılamıyor makro.
Set s2 = ThisWorkbook.Worksheets("data1")

Set s2 = ThisWorkbook.Worksheets("data2")

Set s2 = ThisWorkbook.Worksheets("data3")

Set s2 = ThisWorkbook.Worksheets("data4")

Set s2 = ThisWorkbook.Worksheets("data5")

Set s2 = ThisWorkbook.Worksheets("data6")

Set s2 = ThisWorkbook.Worksheets("data7")

Set s2 = ThisWorkbook.Worksheets("data8")
 
Son düzenleme:
Aşağıdaki şekilde çoğalttım kodları maalesef çalıştıramadım.
Makroyu.

Kod: 
Sub sayfaya_kaydett1()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data1")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett2()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data2")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett3()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data3")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett4()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data4")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett5()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data5")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett6()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data6")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett7()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data7")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
Sub sayfaya_kaydett8()
Set s1 = ThisWorkbook.Worksheets("giriş")
Set s2 = ThisWorkbook.Worksheets("data8")
If s1.Cells(2, 3) = "" Then Exit Sub
sonsatir = s2.Range("B65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = sonsatir - 3
 For zz = 2 To 9
  s2.Cells(sonsatir, zz) = s1.Cells(zz, 3)
 Next zz
MsgBox "Kayıt İşlemi BİTTİ.", vbInformation
End Sub
 
Siz yazmış olduğunuz makroları eklediğiniz düğmelere bağladınızmı.

ekli resime bir bakın
 

Ekli dosyalar

Evet üstad, 8 butondan 3 butonu bağlayabildim. Diğerlerinde 5 butonda Başvuru geçerli değil mesajı vermektedir.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst