Hücredeki sayfa ismine göre sayfa kopyala yapıştır

[ASLAN7410]

Merhaba hayırlı geceler.

Ekte gönderdiğim excel dosyamın BİLGİLER sayfasının J2 hücresinde veri doğrulamada sayfa isimleri var,
buradan istediğim sayfayı seçip butona bastığımda ilgili sayfadaki A ile G sütunundaki bilgilerin getirilmesini istiyorum.

Bir türlü yapamadım, yardımcı olur musunuz?

 

[turist]

Aşağıdaki kodu Module1 'e yazarak deneyiniz.
Sub Düğme3_Tıklat()
Dim sayfa As String
sayfa = Range("J2").Value
Sheet5.Range("A1:G65536") = Empty
Sheets(sayfa).Select
Range("A1:G" & Cells(Rows.Count, 1).End(xlUp).Row).Copy Sheet5.Range("A1")
Sheet5.Select
MsgBox sayfa & " Sayfası getirildi", vbInformation, "İşlem Bitti"
End Sub

 

[ASLAN7410]

Sayın turist ilginiz için çok teşekkür ediyorum, hayırlı geceler.

Sheet5.Range("A1:G65536") = Empty bu kod sırasında hata verdi.

 

[turist]

Sheets("BİLGİLER").Range("A1:G65536") = Empty

veya

Sheets("BİLGİLER").Range("A1:G65536").ClearContents

veya

Sheets("BİLGİLER").Range("A1:G65536") = ""

olarak değiştirin.

 

[ASLAN7410]

Sayın turist ellerinize sağlık çok teşekkür ediyorum. Allah razı olsun.

Hayırlı geceler, hayırlı cumalar diliyorum.

 

[turist]

Sağolun Aslan Bey.

 

[ASLAN7410]

Sayın turist kodu kendi orijinal dosyama ekleyip çalıştırdığımda imleç dönüyor, yanıt vermiyor diye yazıp uzun süre bekledikten sonra işlemi tamamlıyor.

Bunun nedeni ne olabilir?

 

[turist]

Verilerinizin çokluğu , Sayfa isimlerinde hata veya kodu etkileyen başka bir makro gibi bir çok sebep olabilir.
Orijinal dosyanızın "gerçek bilgiler içermeyen" örneğini eklerseniz, belki daha sağlıklı bir yöntem bulunur.

 

[ASLAN7410]

Sayın turist, kod şimdide hızlı çalışıyor anlamadım.

Bu şekilde iyi, çok teşekkür ediyorum.

 

[Ömer BARAN]

Merhaba.

Benimki de düğme kullanmadan çalışan kod alternatifi olsun, J2'de seçim yapmanız yeterli.
Kod'u BİLGİLER sayfasının kod bölümüne uygulayın.
Sayfa isimleri listesinde BİLGİLER sayfasının adı hiçbir şekilde yer almayacaksa kırmızı renklendirdiğim satırı silebilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J2]) Is Nothing Then Exit Sub
If Cells(Rows.Count, 1).End(3).Row > 1 Then _
    Range("A2:G" & Cells(Rows.Count, 1).End(3).Row).ClearContents
brn = Target.Value
If brn = "BİLGİLER" Then MsgBox "Başka bir sayfa adı seçin."
If Sheets(brn).Cells(Rows.Count, 1).End(3).Row > 1 Then
Sheets(brn).Range("A2:G" & Sheets(brn).Cells(Rows.Count, 1).End(3).Row).Copy [A2]
Else: MsgBox "Seçilen sayfada veri yok."
End If
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, ellerinize sağlık, bu da güzel oldu, size de çok teşekkür ediyorum. Allah razı olsun.

Hayırlı geceler diliyorum.

 

[turist]

Sayın turist, kod şimdide hızlı çalışıyor anlamadım.

Bu şekilde iyi, çok teşekkür ediyorum.

Sağolun.
Excel bazen böyle sürprizler yapabiliyor.

 

[Ömer BARAN]

Şayet ilgili sayfalarda mutlaka veri varsa,
önceki cevabımda mavi renklendirdiğim kısımları da (sayfayı yenileyerek kontrol ediniz) silebilirsiniz .

 

[ASLAN7410]

Sayın Ömer Bey, kod bu şekilde iyi tam istediğim gibi çalışıyor. Çok teşekkür ediyorum.

 

[Ömer BARAN]

Kolay gelsin.