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

[YUSUF44]

Bu çözümün sorunla alakasını anlamadım ama sorununuz çözüldüğüne göre kurcalamaya gerek yok. İyi çalışmalar.

 

[Mikdad]

Hocam birleştirme Formulunde bir sıkıntı var sanırım, Rapor sayfasında Birleştir dediğim zaman Gss ve Yardım sayfalarındaki boş sayfaları da alıyor. bakmanız mümkün mü
https://dosya.co/r92zg57pjvui/Gündem_Eksik.xlsm.html

Aşağıdakı Kod ta her Sayfanın D sutununa bakıyor. içerisinde veri olan yere kadar kopyalayıp rapor sayfasına yapıştırıyor. buraya kadar bir sorun yok. asıl sorun Yardım, GSS ve GMADDELERİ sayfasında D stunlarında Formul Olması, formul olduğu için bu kodlar formulu de veri olarak görüyor. yani normalde D250 de veriler bitmiş d250 ye kadar kopyalaması lazım. ama ben formulu d300 e kadar çektiğim için d250 den sonrasını yani formullerin içinde yazılı olduğu ama veri olmayan son 50 satırı da kopyalıyor. biz aşağıdaki formule sadece verile al. formul olan satırları görme diyebiliyor muyuz acaba. bu konuda destek olursanız çok sevinirim.

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("Rapor")
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:Z" & son1).Copy: s3.Cells(yeni1, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s1.Range("A2:Z" & 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:Z" & son2).Copy: s3.Cells(yeni2, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s2.Range("A2:Z" & 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:Z" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone _
        , SkipBlanks:=False, Transpose:=False
s4.Range("A2:Z" & son4).Copy: s3.Cells(yeni3, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

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

End Sub

 

[YUSUF44]

Daha önce de belirttiğim gibi GSSburayakopyala sayfasındaki formüllerinizde birleştirme için " " yani boşluk kullandığınızdan, hücreler asla boş olmuyor.

ikinci durum ise paylaştığınız dosyada sayfa koruması ve şifre var. Bu nedenle gmaddeleri sayfasında D sütununda ne var göremiyoruz.

Yardım sayfasında ise D sütununda formül yok, makronun düzgün çalışması gerekir.

 

[Mikdad]

Hocam Şifre 1453
(GSSburayakopyala sayfasındaki formüllerinizde birleştirme için " " yani boşluk kullandığınızdan, hücreler asla boş olmuyor. ) ben bu kısmı başka bir hücrede birleştirip o hücreyi getirtiyorum. yani "" "" aslında devre dışı kalıyor.
tekrar bakmanız mümkün mü

 

[YUSUF44]

GSS sayfasında D48 hücresini kopyalayın ve boş bir sayfada boş bir hücreye değer olarak yapıştırın. Daha sonra bu boş olması gereken hücreye F2 ile girin ve içinde " " yani boşluk karakteri var mı yok mu gözlemleyin.

 

[YUSUF44]

GMaddeleri sayfasıyla ilgili son satır kodunu D değil de elle giriş yapılan B sütununa göre ayarlarsanız sorun çıkmayacaktır.

 

[Mikdad]

Hocam Haklısınız Gss Sayfasında Malesef D sutununda boşluk var. bundan dolayı dolu gösteriyor. ama bu boşluğu nasıl kaldırabiliriz ki. Dikkat Ederseniz Gss_Buraya_Kopyala Sayfasında R Stununa boşluğu bırakmayacak şekilde al dedim ama yine aynı şey. formule
Sıfır (0) ve Boşluk varsada boş gör demek gibi bir ekleme yapılabilir mi?

 

[YUSUF44]

GSS sayfasında D2 hücresinde aşağıdaki formülü kullanıp aşağı doğru kopyalayınız:

=EĞER('GSS_Buraya Kopyala'!R4=" ";"";'GSS_Buraya Kopyala'!R4)

SYDV makrosunu aşağıdakiyle değiştiriniz. GSS için son satırı GSS asyfasından değil GSSburaya kopyala sayfasının son satırının 2 eksiği olarak belirledim:

Sub SYDV()
Set s1 = Sheets("YARDIM")
Set s2 = Sheets("GSS")
Set s3 = Sheets("Rapor")
Set s4 = Sheets("GMADDELERI")
Set s5 = Sheets("GSS_Buraya Kopyala")

s3.Rows("2:" & Rows.Count).ClearContents
son1 = WorksheetFunction.Max(s1.Cells(Rows.Count, "D").End(3).Row, 2)
son2 = WorksheetFunction.Max(s5.Cells(Rows.Count, "G").End(3).Row, 2) - 2
son4 = WorksheetFunction.Max(s4.Cells(Rows.Count, "B").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

 

[Mikdad]

Hocam Allah Razı Olsun. Yüreğinize Sağlık

 

[Mikdad]

s3.Rows("2:" & Rows.Count).ClearContents
bu komuta A Sutunu ile Z sutununa kadar sil diyebilir miyiz hocam. AA AB ve AC sutunlarında formul var çalıştırınca direk onları da siliyor çünkü

 

[YUSUF44]

Aşağıdaki gibi deneyin:

s3.Range("A2:Z" & Rows.Count).ClearContents

 

[Mikdad]

Yüreğinize Sağlık Hocam