Sayfa veri aktarma

[Kasseria]

Merhaba arkadaşlar benim excell tablomda 30 adet sayfa bulunuyor her sayfada iptal olarak işaretlediğim kırmızı renkte alanlar var 1 sayfada iptaller diye liste var bu iptal olarak göstersiğim kırmızı renkli alanların otomatik olarak iptaller sayfasına eklenmesini istiyorum bu şekilde bir formül var mı?

 

[zpawnz]

Merhaba,

Dosya.co ile yükleyip linki atar mısınız?

 

[Kasseria]

İndir İPTAL DENEME

Dosyayı indir İPTAL DENEME

dosya.co

 

[Korhan Ayhan]

Merhaba,

Rica etsem linki inceleyerek profilinizi güncellermisiniz.

Bilgi - Profillerde yazan "Ofis Sürümü ve Dili" bilgisi hakkında

Merhaba Değerli Forum Üyeleri, Belki dikkatinizi çekmiştir. Son zamanlarda birçok üyemize açtıkları başlıklarda cevap vermeden önce "Kullandığınız ofis sürümü ve dili nedir?" şeklinde mesaj yazıyorum. Bu alanın kullanım amacı sizlere verilecek cevaplar için önem arz etmektedir. Bu sebeple bu...

www.excel.web.tr

 

[Kasseria]

Merhaba office 2013 olarak güncellendim

 

[Korhan Ayhan]

Eksik kalmış dilerseniz linki tekrar inceleyiniz.

 

[Kasseria]

Tamamdır güncelledim office 2013 Türkçe 64 bit

 

[ÖmerBey]

Merhaba,
Aşağıdaki kodu İPTAL OLAN isimli sayfanın kod kısmına kopyalayıp deneyiniz.

Private Sub Worksheet_Activate()
Me.Range("A3:S" & Me.UsedRange.Rows.Count).ClearContents
Dim sh As Worksheet
ReDim dz(1 To 18, 1 To 1)
For Each sh In Worksheets
    If sh.Name <> Me.Name Then
        For a = 5 To sh.Cells(Rows.Count, "B").End(3).Row
            If sh.Cells(a, "B").Interior.Color = vbRed Then
                x = x + 1
                ReDim Preserve dz(1 To 18, 1 To x)
                dz(1, x) = sh.Name
                For b = 2 To 18
                    dz(b, x) = sh.Cells(a, b)
                Next
            End If
        Next
    End If
Next
Me.Range("A3").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub

 

[Kasseria]

Merhaba,
Aşağıdaki kodu İPTAL OLAN isimli sayfanın kod kısmına kopyalayıp deneyiniz.

Private Sub Worksheet_Activate()
Me.Range("A3:S" & Me.UsedRange.Rows.Count).ClearContents
Dim sh As Worksheet
ReDim dz(1 To 18, 1 To 1)
For Each sh In Worksheets
    If sh.Name <> Me.Name Then
        For a = 5 To sh.Cells(Rows.Count, "B").End(3).Row
            If sh.Cells(a, "B").Interior.Color = vbRed Then
                x = x + 1
                ReDim Preserve dz(1 To 18, 1 To x)
                dz(1, x) = sh.Name
                For b = 2 To 18
                    dz(b, x) = sh.Cells(a, b)
                Next
            End If
        Next
    End If
Next
Me.Range("A3").Resize(UBound(dz, 2), UBound(dz)).Value = Application.Transpose(dz)
End Sub

Kodu tam olarak nereye yapıştıracağım

 

[ccuneyt13]

Merhaba,
İPTAL OLAN isimli sayfanın adına sağ tıklayıp Kod Görüntüle yazan yere tıklayın aşağıdaki gibi.
Açılan yere Ömey Bey'in kodlarını yapıştırın.

 

[Kasseria]

Böyle bir uyarı alıyorum

İndir IMG 20240816 144112

Dosyayı indir IMG 20240816 144112

dosya.co

 

[ccuneyt13]

Kodları yapıştırdıktan sonra dosyanızı Farklı Kaydet yapıp aşağıdaki gibi Kayıt Türü kısmını Makro İçerebilen Excel Çalışma Kitabı olarak farklı kaydedin.
Aldığınız hataya Hayır diyerek de farklı kaydet ile dediğim Kayıt türünü seçerek farklı kaydede bilirsiniz.