Makro ile Hücre değerini sayfa adına yazdırma. Yardım.

[ilmtrz]

Merhaba, ekte oluşturduğum makro oluşturduğum tabloyu yeni sayfaya kopyalıyor ve tabloda olan formülleri değere dönüştürüyor. Makroya eklemek istediğim şey mesela a2 hücresinde yazan değeri sayfa adına yazdırmak. Bir de makro düğmesi ikinci sayfada da oluşuyor bunu nasıl engelleriz.

 

[Muhammet Okumuş]

Merhaba,

Sub Kopyala()
Application.ScreenUpdating = False
son = Cells(Rows.Count, 1).End(3).Row
Sheets(1).Name = Cells(2, 1).Value
For i = 3 To son
Sheets(1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets(1).Cells(i, 1).Value
ActiveSheet.DrawingObjects.Delete
Sheets(1).Select
Next
End Sub

Kodu deneyiniz.

 

[ilmtrz]

Public Sub SayfaOlustur()
Application.WorksheetFunction.Proper (Sheets(1).[E3])
For i = 1 To Sheets.Count
If Sheets(i).Name = Sheets(1).[E3] Then Buldum = 1
Next i
If Buldum <> 1 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets(1).[E3]
Sheets(1).Select
End If

End Sub
Merhaba formda şu kodu buldum. Ancak bazı şeyler eklemek istersek nasıl yapabilirim onu bilmiyorum. Mesela düğmeye tıkladığımızda oluşturulmak istenen isimde bir mesaj verin. Şöyle ki, düğmeye tıkladığımızda "Şu isimde sayfa oluşturulmuştur." şeklinde bir mesaj vermesi. Aynı şekilde daha önce de o isimde bir sayfa oluşturmuşsa bir uyarı vermesini istersek mesela bu haliyle düğmeye tıklayınca herhangi bir işlem yapmıyor. Bunun yerine şu mesajı verdirebilir miyiz? "Daha önce bu isimde bir sayfa oluşturdunuz."

 

[ilmtrz]

Merhaba,

Kodu deneyiniz.

teşekkürler hemen deniyorum.

 

[ilmtrz]

Muhammet bey bu kodu benim makro kodunda hangi aralığa koymam gerekir.

 

[Muhammet Okumuş]

Sizin kodunuzda döngü yok. Sadece tek sayfa kopyalayabilirsiniz.

 

[ilmtrz]

Sizin kodunuzda döngü yok. Sadece tek sayfa kopyalayabilirsiniz.

benim kodu tamamen silip sizin kodu mu yapıştırmalıyım.

 

[Muhammet Okumuş]

Düğmenizin üzerine sağ tıklayıp makro ata yapın. Sonra kopyala makrosunu seçip düğmeye basınız.

 

[ilmtrz]

benim kodu tamamen silip sizin kodu mu yapıştırmalıyım.

Hocam vermiş olduğunuz kodu çalıştırdım fakat istediğim bu değil. Formda bulduğu kod tam istediğim gibi ama bahsettiğim eksiklikleri yaparsak tamam olur.

 

[Muhammet Okumuş]

Function SayfaVarMi(SayfaAdi As String) As Boolean
On Error Resume Next
SayfaVarMi = CBool(Len(Worksheets(SayfaAdi).Name) > 0)
End Function


Sub Kopyala()
Application.ScreenUpdating = False
If ActiveCell = "" Then Exit Sub
If Not SayfaVarMi(ActiveCell.Text) Then
sor = MsgBox(ActiveCell.Value & " adlı sayfa oluşturulsun mu?", vbYesNo, "Uyarı")
If sor = vbNo Then Exit Sub
ad = ActiveCell.Value
Sheets(1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = ad
ActiveSheet.DrawingObjects.Delete
Sheets(1).Select
Else
MsgBox ActiveCell.Value & " adında sayfa kayıtlı.", vbInformation, "Uyarı"
End If
End Sub

Bu kodları deneyiniz. Açılan sayfa aktif hücrenin değeri olur. Yani BMW adı seçili iken basarsanız BMW adında sayfa oluşturur.

 

[ilmtrz]

Formda bir kod daha buldum uyguladım oldu. Bir eksik kaldı sadece. Düğmeye tıkladığımda eğer o isimde bir sayfa var ise uyarı vermesi gerek.

 

[ilmtrz]

Bu kodları deneyiniz. Açılan sayfa aktif hücrenin değeri olur. Yani BMW adı seçili iken basarsanız BMW adında sayfa oluşturur.

Hocam vermiş olduğunuz kod süper. Bunu sadece bir hücreyle sabitleyebilir miyiz. Mesela her seferinde a2 deki hücreden alsın.

 

[Muhammet Okumuş]

Sub Kopyala()
Application.ScreenUpdating = False
If Range("A2") = "" Then Exit Sub
If Not SayfaVarMi(Range("A2").Value) Then
sor = MsgBox(Range("A2").Value & " adlı sayfa oluşturulsun mu?", vbYesNo, "Uyarı")
If sor = vbNo Then Exit Sub
ad = Range("A2").Value
Sheets(1).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = ad
ActiveSheet.DrawingObjects.Delete
Sheets(1).Select
Else
MsgBox Range("A2").Value & " adında sayfa kayıtlı.", vbInformation, "Uyarı"
End If
End Sub

deneyiniz.

 

[ilmtrz]

deneyiniz.

Çok ama çok teşekkür ederim. Allah bin kere razı olsun. İyi formlar.

 

[ilmtrz]

Muhammet bey, küçük bir şey daha isteyebilir miyim? Oluşturulan sayfadaki formüllerin devredışı kalması mümkün mü?

 

[Muhammet Okumuş]

ActiveSheet.Name = ad
yazan kodun altına
Range("A2:I100") = Range("A2:I100").Value
yapıştırınız. Satır ve sütun aralıklarını ayarlayınız.

 

[ilmtrz]

ActiveSheet.Name = ad
yazan kodun altına
Range("A2:I100") = Range("A2:I100").Value
yapıştırınız. Satır ve sütun aralıklarını ayarlayınız.

Tamamdır hocam çok çok teşekkür ediyorum.

 

[Muhammet Okumuş]

Rica ederim. İyi çalışmalar.