• DİKKAT

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

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

I

ilmtrz

Katılım
27 Aralık 2012
Mesajlar
245
Excel Vers. ve Dili
Excel 2019
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.
 

Ekli dosyalar

Son düzenleme:
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
Genişletmek için tıkla ...
Kodu deneyiniz.
 
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."
 
Muhammet bey bu kodu benim makro kodunda hangi aralığa koymam gerekir.
 
Sizin kodunuzda döngü yok. Sadece tek sayfa kopyalayabilirsiniz.
 
Düğmenizin üzerine sağ tıklayıp makro ata yapın. Sonra kopyala makrosunu seçip düğmeye basınız.
 
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
Genişletmek için tıkla ...
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.
 
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.
 

Ekli dosyalar

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
Genişletmek için tıkla ...
deneyiniz.
 
Muhammet bey, küçük bir şey daha isteyebilir miyim? Oluşturulan sayfadaki formüllerin devredışı kalması mümkün mü?
 
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.
 
Rica ederim. İyi çalışmalar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst