İki Sayfadaki Değerleri üçüncü sayfaya Birleştirmek

[Mikdad]

Selamun Aleykum Dostlarım,
Excel de
YARDIM
GSS
TOPLU
Şeklinde üç sayfam var. sutun başlıkları aynı.
benim yapmak istediğim şey şu. Önce Yardım sayfasını daha sonra gss Sayfasını Toplu Sayfasına işleyecek.
yardım ve gss sayflarında değişken veriler oluyor. bazen yardım sayfasında 3000 kayıt gss de 500 kayıt bazen de tersi oluyor.
Dostlarım Biraz aciliyet arz ediyor. yardımcı olabilirseniz sevinirim.

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")

son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "A").End(3).Row, 2)

yeni1 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s1.Range("A2:Z" & son1).Copy s3.Cells(yeni1, "A")
yeni2 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s2.Range("A2:Z" & son2).Copy s3.Cells(yeni2, "A")

MsgBox "İşlem Tamamlandı", vbInformation

End Sub

 

[Mikdad]

hocam verdiğiniz macroyu sizinle paylaştığım sayfada az veri ile çalışıyor. ama asıl veriler ile çalıştırdığım da YARDIM sayfasını eksiksiz getiriyor ama GSS yi getirmiyor. neden olabilir.

 

[YUSUF44]

GSS'nin A sütunu boş olabilir mi?

 

[Mikdad]

evet hocam a sutunu boş ama gss sayfasında a sutunu boş oluyor hocam. yani boşkende aktarma yapamaz mı?
birde hem yardım hemde gss sayfasında AC sutunundaki verileri de almak istiyorum.

 

[YUSUF44]

Bunu bilemezdik doğal olarak çünkü verdiğiniz dosyada A sütunu doluydu. Bunun için örnek dosyanın asıl dosyayla aynı olmasını istiyoruz.

son2 = satırındaki "A" yerine "B" kullanın, ya da o tabloda en çok hangi sütun doluysa o sütunu kullanın.

son1 ve son2 değişkenleri sayfalardaki son dolu satırı bulmak için kullanılıyor, bu da aktarılacak verinin nereye kadar olduğunu bilmemizi sağlıyor.

 

[YUSUF44]

Önceki cevabımla bağlantılı olarak örnek dosyanızda AC sütunlarında bir şey olmadığından doğal olarak onları değerlendirmemiştim. AC sütununu da almak istiyorsanız koddaki A2:Z ifadelerini A2:AC olarak değiştirmeniz gerekir.

 

[Mikdad]

Hocam söylediğiniz gibi D sutununu gösterdim. ve a2:z yerinea2:AC diyince sorun çözüldü yanlız şöyle bir problemim var. Hem Yardım Hemde Gss sayfalarını ='GSS_Buraya Kopyala'!Q2173 şeklinde bir komutla çekiyorum. yani aslında asıl sayfa o değil çok daha geniş ve karışık bir sayfadan sadece bana lazım olanları çekiyorum. sizin bu macro ile normal verileri getiriyor . ama formulle getirttiğim verileri getirmek yerini 0 Sıfır şeklinde gösteriyor hücrelerin üzerine tıkladığım zamanda
='GSS_Buraya Kopyala'!Q2173 formulu getirmiş oluyor.
yani hem yardım hemde gss sayfasına formul ile gelmiş olan verileride kopyalama bir bir seçenek yapılabilir mi?

 

[Mikdad]

Macro Son Hali İle
//////////////////////////
Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")

son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "d").End(3).Row, 2)

yeni1 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s1.Range("A2:ac" & son1).Copy s3.Cells(yeni1, "A")
yeni2 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s2.Range("A2:ac" & son2).Copy s3.Cells(yeni2, "a")

MsgBox "İşlem Tamamlandı", vbInformation

End Sub
////////////////////////
bu makroya eğer hücrenin değerlerini al demek gerekiyor. yani formul ile de gelmiş ise sonuç olarak gelen değerin kopyalanması lazım.

 

[YUSUF44]

Aşağıdaki gibi deneyiniz:

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")

son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "D").End(3).Row, 2)

yeni1 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
       
yeni2 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

MsgBox "İşlem Tamamlandı", vbOKOnly, "SYDV"

End Sub

 

[Mikdad]

Hocam Hakkınızı Helal Edin Ellerinizi Sağlık tam istediğim gibi . sadece şunu sormak istiyorum.
1 sayfa daha eklemek istersek ne yapmamız lazım .
mesala
GUNMADDELER
diye bir sayfa daha yapsak ve onları da kopyalamak istesek.
herşey için teşekkütr Ederim.

 

[YUSUF44]

Aslında kendiniz yapabilirsiniz.

Set ile başlayan satırlarda daha sonra kolay yazabilmek için sayfalara kısa isim veriyoruz

son1 ve son2 ile kopyalanacak sayfalardaki son dolu satırın numarasını buluyoruz

yeni1 ve yeni 2 ile yapıştırma işleminden önce s3 yani TOPLU sayfasındaki ilk boş satırın numarasını buluyoruz.

Diğer satırlar ise mevcut verilerin kopyalanıp TOPLU sayfasına önce biçim sonra da değer olarak yapıştırılması için.

 

[Mikdad]

Hocam Kodu Bu Şekilde Guncelledim ama sanırım bir yerde hata yaptım. dağınık ve anlamsız alanlar kopyalıyor. nerede hata yaptım acaba

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")
Set s4 = Sheets("GMADDELERI")
son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "D").End(3).Row, 2)
son3 = WorksheetFunction.Max(s4.Cells(Rows.Count, "D").End(3).Row, 2)

yeni1 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
yeni2 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        yeni3 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s4.Range("A2:AC" & son3).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s4.Range("A2:AC" & son3).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

MsgBox "İşlem Tamamlandı", vbOKOnly, "SYDV"

End Sub

 

[YUSUF44]

G maddeleri sayfasında son satır D sütununa göre belirlenmiyorsa son4 değişkenini ona göre güncelleyin.

Son yapıştırma kısmında yeni2 değişkeni kullanmışsınız, yeni3 olmalı.

 

[Mikdad]

Hocam kodu bu şekilde değiştirdim bu seferde aşağıdaki hatayı verdi.

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")
Set s4 = Sheets("GMADDELERI")
son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "D").End(3).Row, 2)
son4 = WorksheetFunction.Max(s4.Cells(Rows.Count, "D").End(3).Row, 2)


yeni1 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
yeni2 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        yeni3 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s4.Range("A2:AC" & son3).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s4.Range("A2:AC" & son3).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

MsgBox "İşlem Tamamlandı", vbOKOnly, "SYDV"

End Sub

 

[YUSUF44]

Yukarda son4 belirlemiş, aşağıda son3 kullanmışsınız.

 

[Mikdad]

Hocam Haklısınız O şekilde düzelttim şuan sorunsuz çalışıyor yanlız önce yardım sonra gmaddeleri ve sonra gss yi kopyalıyıp yapıştırıyor. olması gereken sıra
YARDIM
GSS
GMADDELERI
şeklinde olmalıydı. sırasını nasıl kontrol ediyoruz.

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")
Set s4 = Sheets("GMADDELERI")
son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "A").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "D").End(3).Row, 2)
son4 = WorksheetFunction.Max(s4.Cells(Rows.Count, "D").End(3).Row, 2)


yeni1 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
yeni2 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        yeni3 = s3.Cells(Rows.Count, "A").End(3).Row + 1
s4.Range("A2:AC" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s4.Range("A2:AC" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

MsgBox "İşlem Tamamlandı", vbOKOnly, "SYDV"

End Sub

 

[YUSUF44]

Kodlar yazıldığı sırayla çalışır.

Verdiğiniz son halinde önce s1 yani yardım, sonra s2 yani gss ve sonra da s4 yani gmaddeleri sayfaları kopyalanıyor.

 

[Mikdad]

Hocam malesef önce yardım sonra gmaddelir ve en sonra gss yi yapıştırıyor. gmaddelerini en sona koplaması lazım. isterseniz bir kontrol edin
Sıralama Olması Gereken
YARDIM
GSS
GMADDELERI

 

[Mikdad]

Yusuf44 Hocam Hakkınızı Helal Edin Sizi Çok Yordum. Aşağıdaki Şekilde Olayı Çözdüm. Bütün Sayfalardı D sutununu kontrol et diyince sorun çözüldü. Tekrar Teşekkür Ederim.

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("TOPLU")
Set s4 = Sheets("GMADDELERI")
son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "D").End(3).Row, 2)
son2 = WorksheetFunction.Max(s2.Cells(Rows.Count, "D").End(3).Row, 2)
son4 = WorksheetFunction.Max(s4.Cells(Rows.Count, "D").End(3).Row, 2)


yeni1 = s3.Cells(Rows.Count, "D").End(3).Row + 1
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s1.Range("A2:AC" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
      
yeni2 = s3.Cells(Rows.Count, "D").End(3).Row + 1
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s2.Range("A2:AC" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        
        yeni3 = s3.Cells(Rows.Count, "D").End(3).Row + 1
s4.Range("A2:AC" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s4.Range("A2:AC" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

MsgBox "İşlem Tamamlandı", vbOKOnly, "SYDV"

End Sub