• DİKKAT

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

Makro ile farklı sayfalardan satır kopyalama

M

magnet2014

Katılım
10 Nisan 2014
Mesajlar
113
Excel Vers. ve Dili
2013 ingilizce
Arkadaşlar merhaba,

Ekte örneğini ve detaylarını eklediğim üzere Özet sayfasına diğer sayfaların A hücrelerinde 1 olan satırları kopyalatmak istiyorum. Diğer sayfalara sürekli veri girişi yapılıyor dolayısıyla veriler sabit değil. Yardım ve desteğiniz için çok teşekkür ederim.

Saygılarımla
 

Ekli dosyalar

dosyanız ektedir.:cool:
Kod: 
Sub Düğme2_Tıklat()
Range("A2:Q" & Rows.Count).Clear

End Sub
Sub Düğme1_Tıklat()
Dim i As Long, sonsat As Long, sat As Long, k As Integer
Dim myarr()
sat = 3
Sheets("ÖZET RAPOR").Select
myarr = Array("", "Ch1-1 transfer", "Ch1-1 tr. c.over", "Ch1-2", "Ch1-2 c.over")
For k = 1 To 4
    sonsat = Sheets(myarr(k)).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To sonsat
        If Sheets(myarr(k)).Cells(i, "A").Value = 1 Then
            Sheets(myarr(k)).Range("A" & i & ":Q" & i).Copy
            Range("A" & sat).PasteSpecial xlPasteValuesAndNumberFormats
            sat = sat + 1
        End If
    Next i
    sat = sat + 1
    Application.CutCopyMode = False
Next k
MsgBox "işlem tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub
 

Ekli dosyalar

Orion1' Alıntı:
dosyanız ektedir.:cool:
Kod: 
Sub Düğme2_Tıklat()
Range("A2:Q" & Rows.Count).ClearContents

End Sub
Sub Düğme1_Tıklat()
Dim i As Long, sonsat As Long, sat As Long, k As Integer
sat = 3
Sheets("ÖZET RAPOR").Select
For k = 2 To Worksheets.Count
    sonsat = Sheets(k).Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To sonsat
        If Sheets(k).Cells(i, "A").Value = 1 Then
            Sheets(k).Range("A" & i & ":Q" & i).Copy
            Range("A" & sat).PasteSpecial
            sat = sat + 1
        End If
    Next i
    sat = sat + 1
    Application.CutCopyMode = False
Next k
MsgBox "işlem tamamdır." & vbLf & "evrengizlen@hotmail.com"
End Sub
Genişletmek için tıkla ...

Evren Bey,

Cevabınız için çok teşekkür ederim. Makro sorunsuz çalışıyor. Son olarak temizle makrosunda sayısal değerler temizleniyor ancak sarı renkli arka fon kalıyor. Bunu da sildirebilir miyiz?

Bir de data çekilecek sayfaların orjina isimleri sheet1, sheet2 şeklinde değil. 1. sayfa ismi "Ch1-1 transfer", 2. sayfa ismi "Ch1-1 tr. c.over", 3. sayfa ismi "Ch1-2" 4. sayfa ismi "Ch1-2 c.over"
 
tarhan822' Alıntı:
ekli dosyada
Genişletmek için tıkla ...

Tarhan Bey,


Cevabınız için çok teşekkür ederim. Makro sorunsuz çalışıyor. Son olarak dataları getirdikten sonra sayısal alana kenar çizgilerini çizebilir mi?

Bir de data çekilecek sayfaların orjina isimleri sheet1, sheet2 şeklinde değil. 1. sayfa ismi "Ch1-1 transfer", 2. sayfa ismi "Ch1-1 tr. c.over", 3. sayfa ismi "Ch1-2" 4. sayfa ismi "Ch1-2 c.over"
 
Arka plan rengini kaldırmak için
Kod: 
Range("A2:Q" & Rows.Count).Interior.ColorIndex = xnull
 
renkleri kaldırmak içi sayın askm yanıtlamış.
Dosyada sayfa isimleri ile değilde sayfa indexleri ile kodlama yaptım.Sayfa isimleri ne olursa olsun ilk sayfa hariç diğer sayfalarda işlem yapıyor.:cool:
 
Merhaba.

For...Next döngüsüyle alternatif olsun.
.
Kod: 
[FONT="Arial Narrow"][B]Sub AKTAR()[/B]
Set oz = Sheets("ÖZET RAPOR")
    If oz.[B65536].End(3).Row > 1 Then
        With oz.Range("A2:Q" & oz.[B65536].End(3).Row)
            .Clear: End With: End If
                For sayfa = 1 To Worksheets.Count
                    If oz.[B65536].End(3).Row = 1 Then osat = 2
                        oz.Cells(osat, 2) = "@"
                            If Sheets(sayfa).Name <> "ÖZET RAPOR" Then
                                For ssat = 2 To Sheets(sayfa).[B65536].End(3).Row
                                    If Sheets(sayfa).Cells(ssat, 1) = 1 Then
                                        osat = oz.[B65536].End(3).Row + 1
                                    If osat = 2 Then osat = osat + 1
                                For ssut = 1 To 17
                            oz.Cells(osat, ssut) = Sheets(sayfa).Cells(ssat, ssut): Next
                        osat = osat + 1: ssut = Empty: End If: Next: ssat = Empty: End If: Next
                    For satır = 2 To oz.[B65536].End(3).Row
                If oz.Cells(satır, 1) <> "" Then
            With oz.Range(oz.Cells(satır, 1), oz.Cells(satır, 17))
        .Borders.LineStyle = xlContinuous: .Interior.ColorIndex = 6: End With: End If
    If oz.Cells(satır, 2) = "@" Then oz.Cells(satır, 2) = ""
Next: MsgBox "İŞLEM TAMAM"
[B]End Sub[/B][/FONT]
 
Orion1' Alıntı:
renkleri kaldırmak içi sayın askm yanıtlamış.
Dosyada sayfa isimleri ile değilde sayfa indexleri ile kodlama yaptım.Sayfa isimleri ne olursa olsun ilk sayfa hariç diğer sayfalarda işlem yapıyor.:cool:
Genişletmek için tıkla ...

Merhaba

Sorunum şu ki Excel kitabında birçok sayfa var ben sadece bu sayfalardan veri almak istiyorum Sizi de yordum Tekrar teşekkür ederim
 
Ömer BARAN' Alıntı:
Merhaba.

For...Next döngüsüyle alternatif olsun.
.
Kod: 
[FONT="Arial Narrow"][B]Sub AKTAR()[/B]
Set oz = Sheets("ÖZET RAPOR")
    If oz.[B65536].End(3).Row > 1 Then
        With oz.Range("A2:Q" & oz.[B65536].End(3).Row)
            .Clear: End With: End If
                For sayfa = 1 To Worksheets.Count
                    If oz.[B65536].End(3).Row = 1 Then osat = 2
                        oz.Cells(osat, 2) = "@"
                            If Sheets(sayfa).Name <> "ÖZET RAPOR" Then
                                For ssat = 2 To Sheets(sayfa).[B65536].End(3).Row
                                    If Sheets(sayfa).Cells(ssat, 1) = 1 Then
                                        osat = oz.[B65536].End(3).Row + 1
                                    If osat = 2 Then osat = osat + 1
                                For ssut = 1 To 17
                            oz.Cells(osat, ssut) = Sheets(sayfa).Cells(ssat, ssut): Next
                        osat = osat + 1: ssut = Empty: End If: Next: ssat = Empty: End If: Next
                    For satır = 2 To oz.[B65536].End(3).Row
                If oz.Cells(satır, 1) <> "" Then
            With oz.Range(oz.Cells(satır, 1), oz.Cells(satır, 17))
        .Borders.LineStyle = xlContinuous: .Interior.ColorIndex = 6: End With: End If
    If oz.Cells(satır, 2) = "@" Then oz.Cells(satır, 2) = ""
Next: MsgBox "İŞLEM TAMAM"
[B]End Sub[/B][/FONT]
Genişletmek için tıkla ...

Ömer Bey

Teşekkür ederim Örneğim de sheet1234 diye belirttim benim hatam. Ancak data çekilecek sayfaların orjina isimleri sheet1, sheet2 şeklinde değil. 1. sayfa ismi "Ch1-1 transfer", 2. sayfa ismi "Ch1-1 tr. c.over", 3. sayfa ismi "Ch1-2" 4. sayfa ismi "Ch1-2 c.over". Diğer sayfalardan veri almasın istiyorum Yardımcı olurmusunuz
 
magnet2014' Alıntı:
Evren Bey,

Cevabınız için çok teşekkür ederim. Makro sorunsuz çalışıyor. Son olarak temizle makrosunda sayısal değerler temizleniyor ancak sarı renkli arka fon kalıyor. Bunu da sildirebilir miyiz?

Bir de data çekilecek sayfaların orjina isimleri sheet1, sheet2 şeklinde değil. 1. sayfa ismi "Ch1-1 transfer", 2. sayfa ismi "Ch1-1 tr. c.over", 3. sayfa ismi "Ch1-2" 4. sayfa ismi "Ch1-2 c.over"
Genişletmek için tıkla ...
2 nolu mesajda dosyayı güncelledim.Oradan dosyayı indirebilirsiniz.:cool:
 
Orion1' Alıntı:
2 nolu mesajda dosyayı güncelledim.Oradan dosyayı indirebilirsiniz.:cool:
Genişletmek için tıkla ...

Evren Bey,

Ellerinize emeğinize sağlık. Eğer vaktiniz olursa son birşey daha sormak istiyorum. Özet Rapor sayfasına 2 buton daha eklemek istiyorum;

1. butona basıldığında benzer şekilde A hücresi 1 olan ve D hücresinde "B","A" ve "A+" yazanları getirsin

2. butona basıldığında ise yine A hücresi 1 olan, D hücresinde "B","A" ve "A+" olan ve N hücresi eksi değerli satırları getirsin

Sizi de uğraştırdım ancak çok makbule geçti. Ne kadar teşekkür etsem azdır.
 
Sayın Evren

Ben hallettim Emeğiniz ve ilginiz için size ve cevaplayan tüm arkadaşlara teşekkür ederim
 
Arkadaşlar foruma yeni üye oldum biraz araştırdım ama bulamadım. A1,B1,C1 hücrelerinde sırasıyla Ocak,Şubat,Mart yazıyor. Başka bir hücrede G1 hücresinde bu üç aydan herhangi biri yazıyor burası sabit değil yani ocakta yazabilir şubatta martta değişken. G2 hücresinde ise bir rakam var örneğin 20 olsun. G1 hücresinde hangi ay yazıyorsa ocak şubat mart altındaki rakamı A1 B1 C1 ilgili ayın altındaki hücreye kopyalasın. bunu makro ile yapabilirmiyiz. şimdiden teşekkür ederim kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst