Sayfaya girilen değer kadar Kopyalama

[efem67]

ANASAYFA Sayfasında Açılacak olan bir Giriş Butonu ile Girilen Değer Kadar 1,2,3,4,5,6,....20 YE KADAR
SONUC Sayfasındaki A11 den X11 e kadar olan ve içerisinde formüller olan satırımı Yine SONUC sayfasında
Alt Alta Kopyalama nasıl yapabilirim. Yardımlarınız için teşekkür ederim..

bir örnek buldum ama uyarlayamadım...
Sub satir_ekle()
Dim i As Integer, son As Long, tss As Long, bit As Integer
Range("A65536").Select
Selection.End(xlUp).Select
Do Until ActiveCell.Value = ""
If ActiveCell.Value = ActiveCell.Offset(-1, 0).Value Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.EntireRow.Insert

End If
Loop

With ActiveSheet
son = .Range("b65536").End(3).Row - 2
For i = 1 To .Range("IV1").End(1)
If .Cells(son, i + 1).HasFormula Then
.Cells(son, i + 1).Copy
.Cells(son + 1, i + 1).PasteSpecial xlPasteFormulas
End If
Next i
End With
Application.CutCopyMode = False
i = Empty: son = Empty

End Sub

 

[turist]

İstediğinizi içeren örnek excel dosyanızı eklerseniz; daha kolay yardım alabilirsiniz.

 

[efem67]

Hocam ek dosya olarak ilettim Saygılarımla;
Yardımlarınızı ivedilikle bekliyorum..

 

[turist]

Ekli Dosyayı inceleyiniz.

 

[efem67]

Çok Teşekkür ederim , Son bir yardım daha alabilirmiyim. 10 ve veya 20 adet seçimi sonrası
içerisine yazılacak olan şifre ile sayfa koruyabilirmiyim macro ile.. Teşekkürler

 

[turist]

"10 ve veya 20 adet seçimi sonrası" ifadenizi biraz daha açarbilirmisiniz?
10 ve veya 20 defa seçim mi, yoksa 10 ve veya 20 değerlerini seçtiğinizde mi?
Hangi sayfa şifre ile korunacak?

 

[efem67]

seçim yaptıktan sonra , tamam dediğimizde HAKEMSONUC sayfayısını aynı anda içerisine yazacağım veya belirleyeceğim bir şifre ile koruma altına almam lazım, aksi taktirde yazdığımız fonksiyonları yanlışlıkla silinebilir.. 1,2,3,4,5.....20 ye kadar seçim yanında tamam butonu bu butona bağlı olarakta şifre ile koruma, şifre kullanıc tarafından değil makronun içinde olabilirmi..
Çok Teşekkür ederim...

 

[efem67]

Hocam birde satırlar kopyalandıktan sonra ; artık hesaplama verileri girilirken örneğin E4 ile Q4 arasında değerler değiştirildiğinde
hücrelerdeki hesaplama sonrası 1.2.3.... yazı ile birinci ikinci üçüncü ... hesaplamalarını yapmıyor. gelmiyor..

 

[turist]

"SayfaANA" sayfasında açılır Liste (DropDown) ile seçim yaptıktan sonra;
"HAKEM SONUC" sayfanızda sayfa koruması oluşacaktır.
VBA editor sayfasını açarsanız (ALT + F11 ile) Module1 deki Macro kodunda şifrenizi "abc" olarak göreceksiniz.İstediğiniz şifre ile değiştirebilirsiniz.
Yeni hali ile dosyanız eklidir.

 

[turist]

Hocam birde satırlar kopyalandıktan sonra örneğin E4 ile Q4 arasında değer ler değiştiğinde
hücrelerdeki hesaplama sonrası 1.2.3. yazı ile birinci ikinci üçüncü gelmiyor..

U4 hücresindeki formülünüzde hata var.

=IF(OR(T4="";T4="DİSKALİFİYE");"";RANK([B][COLOR="Red"]T4;$T$4:T4;0[/COLOR][/B]))

şeklinde değiştiriniz.
(Formüller ingilizce fonksiyonludur, siz sadece KIRMIZI renkli kısmı değiştirin)

 

[efem67]

Değerli Hocam bu vakitte bile cevap yazmanız ve sorunları çözmeniz beni inanın çok duygulandırdı ve mahcup oldum..
Burada seçim yapıldıktan sonra kilitli olmayan hücrelere veri giriş yapılacak.
Örneğin: B4 VE Q4 tabi açılan satır kadar
B5 ve Q5 vs koruma yanlızca kilitli olan hücrelerde olmalı Teşekkürler

 

[efem67]

Burada seçim yapıldıktan sonra kilitli olmayan hücrelere veri giriş yapılacak.
Örneğin: B4 VE Q4 tabi açılan satır kadar
B5 ve Q5 vs koruma yanlızca kilitli olan hücrelerde olmalı
=EĞER(YADA(T4="";T4="DİSKALİFİYE");"";RANK(T4;$T$4:T4;0))
Yaptığımda diğer alttaki hesaplamaları yapmıyor
Teşekkürler

 

[turist]

Dosyanız eklidir.

 

[efem67]

Hocam değerlei değiştirdiğimde;
1.2.3 ler arasında sayısal fark var ama eklenen satırlar arasında 1.2.3 yü bulamıyor. ve eşitlik olduğunda
sayfa içindeki kod; açılması gereken sütünlar açılmıyor

 

[efem67]

örnek yaptğım üzere 1. ile 4. ortalama puanı farklı ama ikisinede birinci diyor.
ve 2 adet 1inci olursa
Columns("W:Z").Hidden = False
Columns("W:AE").FormulaHidden = True
Else
Columns("X:Y").Hidden = True
Columns("W:AE").FormulaHidden = True
koduna göre açması lazım onuda malesef yapmıyor.

Ancak rank kısmını RANK(T4;$T$4:$T$7;0)) yaptığımda düzeliyor.

 

[turist]

U4 hücresindeki formülünüzde RANK kısmını;
RANK(T4;$T$4:$T$33;0)) yapın.

"HAKEMSONUC" sayfanızdaki kodu da;

Private Sub Worksheet_Change(ByVal Target As Range)
Call SayfaAç
son = Cells(Rows.Count, 1).End(3).Row
a = 0
For i = 5 To WorksheetFunction.Max(1, son)
' If Cells(i, "P") <> "DİSKALİFİYE" And WorksheetFunction.CountIf(Range("P11:P" & son), Cells(i, "P")) > 1 Then
' WorksheetFunction.CountIf(Range("P11:P" & son), Cells(i, "P")) > 1 Then
If WorksheetFunction.CountIf(Range("T4:T" & son), Cells(i, "T")) > 1 Then
a = a + 1
End If
Next
If a > 1 Then
Columns("W:Z").Hidden = False
Columns("R:AE").FormulaHidden = True
Else
Columns("X:Y").Hidden = True
Columns("R:AE").FormulaHidden = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call SayfaKoru
End Sub

şeklinde değiştirin.
Çalıştırıp sonuçları irdeleyin.

 

[efem67]

Hocam elinize sağlık olmuş ancak; Örneğin önce 15 seçtik, sonra, vaz geçip 10 yaptığımızda A4 sütünündanki sayılar , önce seçtiğimizin
çizgileri yerinde kalıyor.
Bunuda nasıl düzeltebilirz. diğer kodlar mükemmel çalışıyor eniniz kolunuza emeğinize sağlık.
Saygılarımla;

 

[turist]

A4 hücresine;

=EĞER(B4="";"";SATIR()-3)

formülü girin. Tekrar çalıştırıp kontrol edin.

Çizgiler için; koşullu biçimlendirme kullanın.(Önceki yüklediğim dosyada vardı)

 

[efem67]

Hocam vallahi mahcubum şimdide ; Örneğin önce 25 seçtik, sonra, vaz geçip 4 yaptığımızda X ve Y A4 sütünündanki çizgileri yerinde kalıyor.
Bunuda nasıl düzeltebilirz. diğer kodlar mükemmel çalışıyor eniniz kolunuza emeğinize sağlık.
Saygılarımla;

 

[efem67]

Koşullu biçimlendirme ile çözdüm çok teşekkürler hocam